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The  RICIS  Concept 


The  University  of  Houston-Clear  Lake  established  the  Research  Institute  for 
Computing  and  Information  Systems  (RICIS)  in  1986  to  encourage  the  NASA 
Johnson  Space  Center  (JSC)  and  local  industry  to  actively  support  research 
in  the  computing  and  information  sciences.  As  part  of  this  endeavor,  UHCL 
proposed  a partnership  with  JSC  to  Jointly  define  and  manage  an  integrated 
program  of  research  in  advanced  data  processing  technology  needed  for  JSC’s 
main  missions,  including  administrative,  engineering  and  science  responsi- 
bilities. JSC  agreed  and  entered  into  a continuing  cooperative  agreement 
with  UHCL  beginning  in  May  1986,  to  jointly  plan  and  execute  such  research 
through  RICIS.  Additionally,  under  Cooperative  Agreement  NCC  9-16, 
computing  and  educational  facilities  are  shared  by  the  two  institutions  to 
conduct  the  research. 

The  UHCL/R1CIS  mission  is  to  conduct,  coordinate,  and  disseminate  research 
and  professional  level  education  in  computing  and  information  systems  to 
serve  the  needs  of  the  government,  industry,  community  and  academia. 
RICIS  combines  resources  of  UHCL  and  its  gateway  affiliates  to  research  and 
develop  materials,  prototypes  and  publications  on  topics  of  mutual  interest 
to  its  sponsors  and  researchers.  Within  UHCL,  the  mission  is  being 
implemented  through  interdisciplinaiy  Involvement  of  faculty  and  students 
from  each  of  the  four  schools:  Business  and  Public  Administration,  Educa- 
tion, Human  Sciences  and  Humanities,  and  Natural  and  Applied  Sciences. 
RICIS  also  collaborates  with  industry  in  a companion  program.  This  program 
is  focused  on  serving  the  research  and  advanced  development  needs  of 
industry. 

Moreover,  UHCL  established  relationships  with  other  universities  and  re- 
search organizations,  having  common  research  interests,  to  provide  addi- 
tional sources  of  expertise  to  conduct  needed  research.  For  example,  UHCL 
has  entered  into  a special  partnership  with  Texas  A&M  University  to  help 
oversee  RICIS  research  anl  education  programs,  while  other  research 
organizations  are  involved  via  the  “gateway*  concept 

A major  role  of  RICIS  then  is  to  find  the  best  match  of  sponsors,  researchers 
and  research  objectives  to  advance  knowledge  in  the  computing  and  informa- 
tion sciences.  RICIS,  working  Jointly  with  its  sponsors,  advises  on  research 
needs,  recommends  principals  for  conducting  the  research,  provides  tech- 
nical and  administrative  support  to  coordinate  the  research  and  Integrates 
technical  results  into  the  goals  of  UHCL,  NASA/JSC  and  industry. 
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Summary  and  Executive  Overview 

Introduction 


The  Complex  Data  Types  problem  study,  a voluntary  RICIS  study  inaugurated  with  the  advice  of 
the  Data  Management  Systems  Branch  of  the  NASA  Johnson  Space  Center  (JSC)  Right  Data  Sys- 
tems Division  began  during  the  summer  of  1990.  Of  the  important  prioritized  issues  two  categories 
were  chosen  for  investigation.  These  were: 

1.  The  issue  of  using  a preprocessor  on  Ada  code  of  Application  Programs  which 
would  interface  with  the  Run-Time  Object  Data  Base  Standard  Services 
(RODB  STSV);  The  intent  was  to  catch  and  correct  any  mis-registration  errors 
of  the  program  coder  between  the  user  declared  Objects,  their  types,  their 
addresses  and  the  corresponding  RODB  definitions; 

2.  RODB  STSV  Performance  Issues  and  Identification  of  Problems  with  the 
planned  methods  for  accessing  Primitive  Object  Attributes.  This  included  the 
investigation  of  an  alternate  storage  scheme  to  thestore-objects-by-attribute 
scheme  in  the  current  design  of  the  RODB. 

These  two  efforts  were  pursued  in  parallel  the  preprocessor  effort  produced  a preliminary  proto- 
type in  the  summer  of  1991.  With  respect  to  the  RODB  and  STSV  the  study  resulted  in  essentially 
three  separate  documents,  an  interpretation  of  the  system  requirements,  an  assessment  of  the 
preliminary  design  and  a detailing  of  the  components  of  a detailed  design.  These  documents  were 
produced  and  delivered  in  the  Spring  and  Summer  of  1991 . The  requirements  document  was 
produced  in  early  April  [10],  the  preliminary  design  document  was  produced  in  late  April  [9]  and 
the  detailed  design  document  detailing  the  potential  issues  and  problems  was  produced  in  July  of 
1991  [8].  The  code  for  the  preprocessor  was  delivered  in  August  of  1991. 
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Summary  of  Investigations  and  Results 
Preprocessor  Study 

code.  Sped  y d Scrvices.  In  particular  the  part  of  the  application  s code 

CSrwhen  again  subject  ,0  ,hc  Ada  confer  reveals  so,*  or  rbo  semanuc  errors  ,n  ,be 
original  code. 


Preprocessor  Study  Results 

The fundamental resuUs o( ,he experiments  ran  indicated  what £bu«t 
beginning.  The  preprocessor  couid  easily  “ “ “ ‘J as  a mis-registra- 
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ing  code. 


RODB  STSV  Performance  Analysis  Study 

important  of  which  were  the  Detailed  g interlace  Definition  (AP1D)  was 

-- 

the  prime  contractor  McDonnell-Douglas. 

As  mentioned  in  the  nUrodoclion 

Requirements,  Prototype  piTfom,a'nce  boUlcncxbs  or  problem,  areas 

determined  that  there  wue  two  pm  c general  heading  of  Inter-rroces 

might  appear.  All  of  theseareas  may  be classil.ed  unde,  flu  bioad  genu. 


Communication  (IPC).  In  fact  all  three  forms  of  I PC  as  classified  bv  the  UNIX  operating  system  are 
involved.  Specifically  so-called  IPC  Message  Queues,  Semaphores  and  Shared  memory. 

The  two  areas  of  concern  are  the  communications  between  the  Application  (API)  and  the  Applica- 
tion Interface  Service  (AIS)  and  the  accessing,  (i.e.  reading  and  writing  to),  the  RODI3  Component 
itself.  The  AIP-AIS  communication  path  consists  of  two  sets  of  message  queues;  one  is  the  applica- 
tion request  IPC  Message  Queue,  the  other  being  the  response  IPC  Message  Queues.  The  RODB 
Component  "communications"  consists  of  shared  memory  with  "guarding"  semaphores.  There 
were  other  areas  of  concern  such  as  inter-task  communication  (ITC)  but  these  are  wholly  within  the 
Ada  environment  and  were  deemed  to  be  areas  where  study  could  be  postponed  until  funds  were 
available. 

The  IPC  Message  Queues  were  originally  planned  for  use  between  Application  Programs  and  the 
RODB  Executive  system  (REX)  to  open  various  types  of  reads  and  writes  to  the  RODB  Component 
as  well  as  to  confirm  the  validity  of  the  handles  during  an  actual  read  or  write.  The  shared  memory 
and  the  semaphores  were  and  are  to  be  used  during  the  actual  reading  and  writing  of  data. 

The  open  operation  for  the  RODB  is  a STSV  function  which  by  its  nature  must  use  an  IPC  of  some 
sort  and  the  chosen  facility  is  that  of  IPC  Message  Queues.  What  essentially  transpires  is  for  the 
application  to  forward  a request  to  the  STSV  to  allow  the  reading  or  writing  of  a set  of  Object- 
Attribute  pairs.  After  checking  permissions  etc.  STSV  constructs  what  is  called  a "handle",  which  is 
a set  of  addresses  of  the  appropriate  shared  memory  segment  where  the  pertinent  attributes  are 
stored.  This  information  is  then  passed  back  through  a response  queue  to  the  requesting  applica- 
tion. If  nothing  causes  this  information  to  change  the  open  operation  need  only  be  done  once. 
Multiple  reads  may  take  place  as  long  as  the  handle  is  not  closed.  The  handle  is  a structure  main- 
tained by  REX  to  provide  validity  and  access  information  to  the  RODB  Component  objects. 

The  read  or  write  operation  originally  required  an  additional  request  through  the  IPC  Message 
Queue  mechanism  to  verify  the  validity  of  the  handle(s).  Once  a favorable  acknowledgment  was 
received  through  a response  message  queue,  the  application  was  then  free  to  access  the  appropriate 
shared  memory  addresses  to  read  or  write  the  actual  variable  data.  At  that  point  there  was  to  be  a 
relatively  classic  Readers-Writers  problem  in  that  multiple  readers  were  to  be  permitted  to  access 
the  same  object  attribute,  but  when  readers  were  reading  writers  must  wait.  Further  when  a writer 
is  writing  readers  must  wait  until  the  writer  finishes.  While  the  actual  mechanism  of  the  reader- 
writer  was  not  detailed  in  the  documents  the  aforementioned  policy  dictated  at  least  one  set  of 
possible  semaphores  to  solve  the  reader-writer  problem  for  the  RODB  Component  shared  memory. 


Performance  Tests  Implementation  and  Results 

When  the  Lynx  Operating  System  and  the  Alsys  Ada  Compiler  were  received  several  test  code 
segments  were  constructed  and  run.  The  platform  used  to  approximate  the  Embedded  Data  Proces- 
sor (E-DP)  to  be  used  on  the  Might  Data  Systems  for  the  SSE  was  a PS/2  Model  80  with  a 20  Ml  1/ 
clock  rate 


The  first  Complex  Data  Types  test  run  on  this  platform  was  the  IPC  Message  Queue  implementa- 
tion of  the  Request/ Response  message  queues.  A simple  message  was  sent  between  two  C pro- 
grams with  an  acknowledgment  message  sent  in  return.  If  this  was  necessary  for  each  write  and/or 
read,  it  was  postulated  that  for  post  "Scrub,"  with  only  two  application  EDP's  on  the  SSF  and  an 
estimated  10,000  sensors,  that  5000  writes  might  be  required  for  each  ED?  each  cycle.  The  original 
intent  was  for  the  cycle  time  to  be  every  second.  When  the  test  was  run,  it  was  found  that  5000  IRC 
Message  round  trips  could  be  accomplished  in  no  less  that  approximately  six  (6)  seconds.  1 bus  it 
appeared  that  the  use  of  IPC  Message  Queues  for  every  read  or  write  would  not  be  feasible  if  the 
plan  was  even  to  come  close  to  the  original  requirement.  A similar  result  had  been  found  on  a 
Harris  HCX-9,  which  is  supposedly  a much  faster  machine.  This  was  duly  reported  to  the  NASA 
DMS  personnel.  It  is  interesting  to  note  that  IBM  either  suspected  this  fact  or  independently  deter- 
mined this  since  the  latest  design  does  not  require  IPC  Message  Queues  for  every  read  or  write  but 
only  for  the  open  and  close  operations.  Instead  of  requiring  validation  of  the  handles  for  every  read 
or  write  there  is  a RODB  Component  version  number  returned  as  part  of  the  handle  from  the  open 
call.  A corresponding  number  is  stored  in  the  RODB  Component  itself  so  the  validation  check  is 
done  when  the  actual  read  or  write  is  performed. 

The  other  subsystem  potential  problem  area  investigated  was  the  accessing  of  the  RODB  Shared 
Memory  itself.  Here  both  a Shared  Memory  component  and  IPC  Semaphores  were  implemented. 
Again  5000  noncompeting  reads  or  writes  per  cycle  were  postulated  and  simple  begin  and  end 
times  were  recorded.  In  this  case  if  5000  reads  or  writes  were  performed  a total  number  of  between 
two  (2)  and  three  (3)  seconds  were  required.  In  addition  a suspected  deficiency  of  the  semaphore 
operation  of  the  Lynx  Version  2.0  for  the  386  microprocessor  was  found.  It  was  found  that  when  the 
Readers-W ri lers  problem  was  implemented  the  semaphore  semop  system  call  operation  did  not 
perform  in  a manner  consistent  with  AT&T  UNIX  System  V semaphores.  In  fact  atomicity  of  an 
nrrav-nf-semaphore  operations  was  not  enforced  so  that  in  the  Readers-Wrilers  implementation  a 
reader  and  a writer  could  be  accessing  the  same  RODB  Component  at  the  same  time.  When  pnonty 
was  raised  to  work  around  this  problem,  and  the  semop  system  call  was  repeated,  the  performance 
deteriorated  to  requiring  over  seven  (7)  seconds  to  perform  5000  reads  or  writes.  When  concurrent 
and  competing  read  and  write  processes  were  tested,  the  time  for  two  readers  doing  2500  reads 
each  and  a writer  writing  5000  time  to  the  same  attributes  took  a maximum  of  19  seconds  to  com- 
plete. When  the  code  for  dynamically  changing  the  priorities  was  removed  and  just  the  semaphore 
operations  were  left  in  tact  that  time  dropped  to  seven  (7)  seconds.  Then,  however,  mutual  exclu- 
sion was  not  assured.  It  is  interesting  although  probably  moot  to  note  that  if  5000  unprotected 
concurrent  reads  and  writes  are  performed,  the  elapsed  time  is  about  two  (2)  seconds.  What  seems 
indicated  here  is  that  semaphore  operations  may  require  some  lower  level  coding  to  achicv  c 

desired  or  near-desired  results. 

Detailed  results  and  test  programs  are  included  in  the  body  and  appendices  of  this  report 
respectively. 


Summary  of  Conclusions 


It  seems  clear  that  research  and  advanced  development  investigations  have  the  beneficial  effect  of 
identifying  problem  areas  for  even  proposed  production  projects  where  the  slate  of  the  art  is  being 
"pushed".  The  problems  identified  are: 

1 . In  the  absence  of  an  advanced  Object  Oriented  interface  the  naming  conventions 
for  the  application  objects  and  attributes  will  have  to  be  severely  restricted. 

2.  The  use  of  1PC  mechanisms,  though  necessary  for  communication  between 
different  processes,  adds  cost  to  the  processing  time.  It  may  be  necessary  to 
investigate  modifying  the  low  level  code  of  the  operating  system  to  specialize  the 
system  calls  for  efficiency.  In  particular  the  dynamic  changing  of  priorities  and 
IPC  Semaphore  operations  are  costly. 

3.  There  is  another  issue  on  the  semaphores  which  must  be  addressed  at 
some  point.  It  appears  that  the  system  call  semop  does  not  fully  meet  the 
execution  of  a system  call.  This  is  serious  since,  with  this  deficiency,  there  is  no 
guarantee  that  the  semaphores  guarding  the  shared  memory  will  ensure  --  in 
the  implementation  tested--  that  several  processes  will  not  be  in  their  critical 
sections  at  the  same  time. 

One  alternative  to  storing  RODB  data  by  attribute  would  be  to  store  by  object.  While  this  concept  is 
closer  to  what  is  normally  done  by  many  operating  systems  for  user  text  and  data.  In  this  study 
trade-off  studies  were  only  superficially  addressed  and  quantitative  studies  of  these  object  concepts 
could  not  be  done  because  of  limited  knowledge  of  data  needs  of  the  applications  and  limited 
resources.  Similarly,  other  problem  areas  such  as  the  problems  of  dynamic  scheduling  and  dynamic- 
upgrade  as  well  as  interoperability  problems  and  the  issue  of  designing  more  advanced  object 
oriented  interfaces,  among  other  issues,  remain  unsolved. 


Final  Report  of 
Data  Management  Systems 
Complex  Data  Types  Study 

Introduction 


The  Space  Station  Freedom  (SSF)  Data  Management  System  (DMS)  includes  a distributed  but 
centrally  controlled  data  base  and  concomitant  services.  The  Run-Time  Object  Data  Base  (RODB) 
and  Standard  Services  (STSV)  structure  for  the  Space  Station  is  intended  to  provide  data  acquisition 
and  preliminary  processing  for  all  applications  on  the  SSF. 

The  RODB  provides  a current-time  data  repository  which  is  the  medium  through  which  the  various 
applications  communicate  with  each  other  and  under  Mission  Control 

The  RODB,  for  simplicity,  only  provides  the  capability  of  storing  primitive  data  types  such  as 
integers,  floats,  enumeration  and  pointer  types.  The  exception  to  this  limitation  is  the  capability  of 
storing  linear  arrays  of  these  primitive  types.  Records  and  matrices  were  considered  complex  types 
and  as  such  were  not  admissible  but  had  to  be  broken  down  into  their  component  fields  before 
entering  them  into  the  RODB.  Since  records  could  not  be  written  or  read  as  such  from  the  RODB 
there  were  consistency  and  performance  issues  which  deserved  investigation;  hence  this  study  was 
inaugurated  as  a sample  of  relevance  of  academic  research  and  development  to  "real-world" 
problems  by  the  UHCL  Research  Institute  for  the  Computing  and  Information  Sciences  (RICIS), 
with  the  cooperation  of  the  UHCL  and  TAMU  Computer  Science  Faculties. 

Two  salient  areas  seemed  to  be  evident  when  the  functional  design  was  chosen  to  meet  the  basic 
design  represented  by  "SOFTWARE  PRELIMINARY  DESIGN  DOCUMENT  (DATA  MANAGE- 
MENT SYSTEM  STANDARD  SERVICES)  "[1],. 

The  detailed  design  document  entitled  "SOFTWARE  DETAILED  DESIGN  DOCUMENT  (DATA 
MANAGEMENT  SYSTEM  STANDARD  SERVICES)  "[2],  contained  the  information  which  out- 
lined essentially  the  current  structure  of  the  RODB  and  the  STSV.  These  two  broad  areas  of  concern 
became  evident  when  Dr.  Swami  Natarajan  of  TAMU  studied  the  requirements  and  preliminary 
design  for  the  DMS,  RODB  and  SSTV. 

One  of  these  problem  areas  was  the  interfaces  between  the  applications  and  the  DMS.  The  applica- 
tions software  units  were,  by  nature,  separate  executable  programs.  Any  communication  between 
them  and  the  DMS  service  processes  would  have  to  use  the  inter-process  communication  mecha- 
nisms of  the  underlying  operating  system.  The  DMS  architecture  supplies  packages  for  the  applica- 
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DMS  STSV  RODS 
Flow  Control 

As  described  in  DMS  Det.  Des. 
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tions  to  utilize.  These  packages  are  known  as  the  Application  Program  Interface  (API).  They  are 
Ada  packages  which  the  application  programs  can  "with"  and  which  supply  the  requisite  commu- 
nication mechanisms.  Unfortunately  the  interface  between  an  application  processes  and  the  DMS 
service  processes  circumvents  the  strong  typing  checks  of  any  Ada  compiler.  This  implies  that 
some  preprocessing  might  mitigate  the  potential  inconsistency  problem  between  the  two  sub- 
systems (i.e.  Application  and  DMS).  The  description  of  this  interface  is  in  McDonnell  Douglas 
document  No.  MDC  H4193  APPENDIX  I entitled  "INTERFACE  REQUIREMENTS  DOCUMENT 
(SOFTWARE)  APPENDIX  I INTERFACE  CONTROL  DOCUMENT  (ICD)  DATA  MANAGEMENT 
SYSTEM  (IBM)",[3]. 

The  other  area  of  concern  could  be  summed  up  as  the  potentially  deleterious  effect  of  the  complex- 
ity of  inter-process  communication  upon  the  performance  or  throughput  of  the  system.  Both  of 
these  concerns  are  illustrated  on  Figure  1.  "RODB  IPC/ITC  Message  Queue  Flow".  The  portion  of 
the  figure  labeled  API  shows,  as  an  example,  three  application  processes  which  are  linked  to  the 
DMS  via  the  API  packages.  The  rest  of  the  figure  illustrates  the  mechanisms  for  inter-process 
communication  (IPC)  and  inter-task  communication  (ITC). 


RODB  User  Interface  (Preprocessor  Description) 

Problem  Statement 

Applications  use  the  RODB  to  communicate  with  each  other  and  also  to  obtain  data  from  sensors 
and  send  data  to  effectors.  The  particular  problem  we  addressed  in  this  study  was  using  Attribute 
I/O  for  the  user  interface  for  reading  and  writing  data  to  and  from  the  RODB.  The  potential  of  type 
errors  in  using  that  scheme  and  the  use  of  a compile-time  preprocessor  to  catch  these  errors  was 
investigated. 


Outline  of  Preprocessor  Discussion 

The  purpose  here  is  to  examine  the  current  proposed  user  interface  to  the  RODB,  identify  any 
problems  which  may  exist,  suggest  modifications  which  may  overcome  some  of  these  problems, 
and  evaluate  the  alternative  approaches.  The  discussion  in  this  section  is  divided  into  five  parts. 
The  first  part  presents  the  current  interface.  The  second  part  identifies  some  problems  with  the 
interface.  In  part  three,  we  list  and  discuss  some  of  the  approaches  which  may  be  used  to  overcome 
these  problems.  In  the  fourth  part,  we  provide  a comparative  evaluation  of  these  approaches.  In 
part  five.  Appendix  A,  we  outline  the  design  of  a preprocessor  to  address  some  of  these  problems. 
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Part  I:  The  Current  Interface 


To  read  or  write  a record,  applications  must  enumerate  the  individual  fields  involved  - the  interface 
has  no  concept  of  records.  The  programmer  must  construct  two  kinds  of  lists  at  compile-time.  The 
first  is  an  attribute  list,  which  specifies  the  type  of  each  of  the  fields  which  will  be  read  (or  written). 
Each  entry  in  the  attribute  list  consists  of  a pair  of  values,  the  first  element  of  the  pair  being  the  type 
of  the  object  whose  fields  are  to  be  read,  and  the  second  element  being  the  type  of  the  particular 
field  which  is  to  be  read.  Thus  a typical  attribute  list  may  be: 

APT_POSmON_ATTRIBUTE_ARRAY:  constant  STRDB.ATTRIBUTE_ARRAY_T  := 
((AP_TELESCOPE,  RIGHT_ASC), 

(APTELESCOPE,  DEC_DEGREES), 

(AP_TELESCOPE,  DEC_MINUTES), 

(AP  TELESCOPE,  DEC_SECONDS)); 

There  is  no  restriction  that  all  the  entries  in  the  list  must  be  fields  from  the  same  type  of  object; 
indeed,  an  advantage  of  the  interface  is  the  flexibility  it  provides  in  reading  and  writing  fields  in 
different  records  with  a single  RODB  invocation.  The  programmer  must  construct  one  of  these 
attribute  arrays  for  each  different  group  of  field  types. 


The  attribute  array  is  provided  as  a parameter  in  the  call  to  open  an  RODB  handle: 

READ_OPEN  ( ATTRIB UTE_LIST  =>  APT_POSmON_ATTRIBUTE_ARRAY, 
HANDLE  =>  APT_POSmON, 

HANDLE  JD  =>  APT_HANDLE_ID, 

ERRORS_DETECTED  =>  ERRORS_DETECTED, 

ERRORS  =>  ERRORS); 


This  call  initializes  a set  of  internal  RODB  handles  to  access  the  desired  combination  of  fields,  and 
returns  a pointer  to  this  handle  to  the  user. 

For  each  set  of  data  values  to  be  read  or  written,  the  programmer  must  also  construct  another  list 
consisting  of  the  actual  addresses  where  the  data  is  located.  Thus  an  address  list  for  the  above 
example  might  be: 

APT_POSITION_ADDRESS_ ARRAY : constant  STRDB.ADDRESS_ARRAY_T  := 

( APT_POSmON_RECORD.  R1GHT_  ASCENSlON'address, 
APT_POSmON_RECORD.DECLINATION.DEGREES/address/ 
APT_POSITION_RECORD.  DECLINATION . MlNUTES'address, 
APT_POSmON_RECORD.  DECLIN  ATION.SECONDS'add  ress); 
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Each  element  of  this  address  array  must  match  exactly  in  type  the  corresponding  elements  of  the 
attribute  array,  so  that  values  of  the  correct  types  will  be  placed  in  the  corresponding  locations. 

The  address  array  is  provided  as  a parameter  on  the  READ  call: 

ATTRIBUTE_RE A D (HANDLE_LIST  =>  LIST  OF  (APT_POSmON), 

POSITIONS  =>  APT_POSITION_ADDRESS_ ARRAY, 

ERRORS_DETECTED  =>  ERRORS_DETECTED, 

ERRORS  =>  ERRORS); 

APT_POSITION_ATTRIBUTE_ ARRAY : constant  STRDB.ATTRIBUTE_ARRAY_T  := 
((AP_TELESCOPE,  RIGHT_ASC), 

(AP_TELESCOPE,  DEC_DEGREES), 

(AP_TELESCOPE,  DEC_MINUTES), 

(AP_TELESCOPE,  DEC_SECONDS)); 

There  is  no  restriction  that  all  the  entries  in  the  list  must  be  fields  from  the  same  type  of  object; 
indeed,  an  advantage  of  the  interface  is  the  flexibility  it  provides  in  reading  and  writing  fields  in 
different  records  with  a single  RODB  invocation.  The  programmer  must  construct  one  of  these 
attribute  arrays  for  each  different  group  of  field  types. 


The  attribute  array  is  provided  as  a parameter  in  the  call  to  open  an  RODB  handle: 


READ_OPEN  (ATTRIBUTE_LIST  =>  APT_POSITION_ATTRIBUTE_ARRAY, 
HANDLE  =>  APT_P0SIT10N, 

HANDLE_ID  =>  APT_HANDLE_ID, 

ERRORSDETECTED  =>  ERRORS_DETECTED, 

ERRORS  =>  ERRORS); 


This  call  initializes  a set  of  internal  RODB  handles  to  access  the  desired  combination  of  fields,  and 
returns  a pointer  to  this  handle  to  the  user. 

For  each  set  of  data  values  to  be  read  or  written,  the  programmer  must  also  construct  another  list 
consisting  of  the  actual  addresses  where  the  data  is  located.  Thus  an  address  list  for  the  above 
example  might  be: 

APT_POSrTION_ADDRESS_ARRAY:  constant  STR DB . A D DR ESS_ ARRAY  T := 
(APT_POSmON_RECORD.RIGHT_ASCENSION'address, 
APT_POSmON_RECORD.DECLINATION.DEGREES'address, 
APT_POSmON_RECORD.DECLINATION.MINUTES'address, 
APTPOSmONRECORD.DECLINATION.SECONDS'address); 


to 


Each  element  of  this  address  array  must  match  exactly  in  type  the  corresponding  elements  of  the 
attribute  array,  so  that  values  of  the  correct  types  will  be  placed  in  the  corresponding  locations. 

The  address  array  is  provided  as  a parameter  on  the  READ  call: 

ATTRIBUTE_READ  (HANDLE_LIST  =>  LIST  OF  (APT_POSmON), 

POSITIONS  =>  APT_POSITION_ADDRESS_ ARRAY, 

ERRORS_ DETECTED  =>  ERRORS_ DETECTED, 

ERRORS  =>  ERRORS); 

The  RODB  code  accesses  its  internal  data  using  the  handles,  and  transfers  each  data  item  into  the 
corresponding  address  provided  in  the  address  array. 

Part  II:  Issues 

Potential  Problems  with  the  User  Interface 

1.  Type  checking 

When  applications  read  or  write  records  to  the  RODB,  the  type  checking  features  of  Ada  are  by- 
passed. Since  the  address  list  specifies  only  physical  addresses,  any  datatype  may  be  placed  in 
these  addresses.  The  RODB  does  check  the  types  read  with  the  attribute  list,  but  there  is  no  way  of 
checking  whether  the  address  provided  is  indeed  the  address  of  a variable  of  the  appropriate  type. 
Thus,  there  is  a need  to  type  check  the  addresses  in  the  address  list  with  the  types  specified  in  the 
attribute  list.  Otherwise,  there  may  be  errors  which  could  go  undetected  at  compile-time  and 
possibly  even  during  the  testing  phase.  For  example,  a trivial  error  which  could  easily  occur  is  that 
the  programmer  accidentally  interchanges  two  of  the  addresses  in  the  address  list.  This  would  not 
be  detected  until  possibly  system  integration  time,  when  the  wrong  values  would  be  retrieved  and 
the  system  would  malfunction. 


2.  Nested  records 

The  current  interface  has  a tendency  to  "flatten  out"  records,  in  the  sense  that  it  only  provides  for  a 
two  level  hierarchy.  Each  entry  in  the  attribute  list  consists  of  two  parts,  an  object  type  and  a field 
type.  In  fact,  it  is  possible  that  an  object  may  itself  contain  several  records,  each  with  several  fields 
etc.  It  is  even  possible  that  the  same  field  name  may  appear  twice  within  the  object,  as  part  of 
different  records.  Ideally,  there  should  be  a way  to  describe  fields  which  are  part  of  more  complex 
record  structures.  This  deficiency  may  impose  restrictions  on  the  schemes  used  by  the  system 
designers  for  designing  data  types  and  creating  field  names. 
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3.  Long  repetitive  lists 

It  is  very  inconvenient  for  the  programmer  to  construct  long  address  and  attribute  lists.  The  pro- 
grammers will  have  a fair  amount  of  work  typing  in  long  elements.  The  records  consist  of  fields  of 
arbitrary  elements.  The  programmer  has  to  be  very  careful  to  type  in  the  corresponding  number  of 
entries.  Typing  in  long  lists  is  inconvenient  and  error-prone. 

For  example, 

APT_POSmON_ADDRESS_ARRAY:  constant  STR  DB . A DDR  ESS_  A RRA  Y_T  := 
(APT_POSmON_RECORD.RIGHT_ASCENSION'address, 
APT_POSrriON_RECORD.DECLINATION.DEGREES'address, 
APT_POSITION_RECORD.DECLINATION.MlNUTES,address, 

APT_POSl  1 lON_RECORD.DECLINATTON.SECONDS'address); 

Repetition  of  this  form  is  very  likely  to  occur,  since  very  often  programmers  will  want  to  read 
several  fields  from  the  same  object.  Some  of  these  problems  could  be  avoided  if  fields  from  the 
same  record  could  be  grouped  together,  in  some  form  similar  to  the  following: 

APT_POSmON_ADDRESS_ARRA Y : constant  STRDB.ADDRESS_ARRAY_T  := 
(APT_POSmON_RECORD,  (RIGHT_ASCENSION'address, 
DECLINATION.DEGREES'address, 

DECLINATION.MINUTES'address, 

DECLINATION.SECONDS.address)); 

The  problem  is  particularly  acute  if  the  programmer  wishes  to  read  the  entire  object,  as  might  often 
happen.  In  this  case,  the  programmer  must  individually  specify  each  field  of  the  object,  when  it 
would  be  much  simpler  to  just  specify  that  the  entire  object  needs  to  be  read. 


4.  Modifiability 


This  interface  is  very  sensitive  to  the  object  structure,  the  RODB  storage  scheme  and  the  entire 
current  RODB  model.  Since  the  space  station  is  expected  to  have  a long  lifetime,  it  is  likely  that 
object  definitions  will  change  substantially,  and  even  the  actual  RODB  internal  structure  and 
interface  design  may  change.  Any  such  changes  would  require  widespread  changes  to  applica- 
tions, affecting  code  in  several  modules  in  each  application. 
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For  example. 


APT_POSmON_ADDRESS_ ARRAY:  constant  STRDB. ADDRESS, A RRAY_T  := 
(APT_POSmON_RECORD.RIGHT_ASCENSION' address, 
APT_POSrTION_RECORD.DECLINATION.DEGREES'address, 
APT_POSmON_RECORD.DECLINATION.MINUTES'address, 
APT_POSmON_RECORD.DECLINATION.SECONDS'address); 


where  the  common  words  are  APT_POSITION_RECORD  and  address.  Since  each  field  is  an 
address,  the  word  address  is  redundant  and  could  be  eliminated.  After  factorization,  a short  list 
is  produced: 

APT_POSITION_ A DDRESS_ARRA Y : constant  STRDB. ADDRESS_ARRAY_T  := 
APT_POSITION_RECORD.  (RIGHT_ASCENSION, 

DECLINATION.DEGREES, 

DECLINATION.MINUTES, 

DECLINATIONSECONDS); 

The  repetitive  nature  of  specifying  information  when  writing  several  fields  for  the  same  record 
makes  it  inflexible  and  error-prone.  If  we  need  to  access  all  the  addresses  in  a record,  it  will 
easier  to  avoid  the  repetitive  specification.  Using  the  above  example  and  assume  that  there  are 
only  4 fields  in  APT_POSmON_RECORD.  Suppose  we  want  access  all  the  fields,  then  it  is  be 
more  convenient  to  perform  this: 

APT_POSmON_ADDRESS_ARRAY:  constant  STRDB. ADDRESS_ARRAY_T  := 

APT_POSmON_RECORD.* 


Write/Read 


Using  the  same  principle,  it  is  convenient  to  write  out  or  read  an  entire  record.  The  program- 
mer does  not  need  to  type  out  the  long  and  repetitive  lists  to  read/write  out  an  entire  record. 


Part  III:  Solutions 


The  preprocessor  should  be  able  to  translate  the  programmer's  input  into  the  form  used  in  the 
existing  scheme.  It  should  be  able  to  perform  datatype  checking  in  order  to  eliminate  any 
errors.  Most  of  all,  it  should  be  convenient  for  the  programmer  to  use. 
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1.  Design  1 


The  programmer  inputs  the  attribute-list  and  the  corresponding  address  list.  The  preprocessor 
allows  the  use  of  shorter  lists  and  eliminate  the  repetitive  specification  of  the  lists.  The  preproces- 
sor will  proceed  to  convert  the  programmer's  input  into  output  that  will  be  used  by  the  present 
scheme. 

During  the  conversion,  datatype  checking  is  performed  to  check  that  there  is  no  errors.  This  will 
prevent  errors  from  occurring  at  run-time. 

An  example: 

Suppose  that  the  programmer's  input  is: 

P_attribute-list  (R1.*,R2.*,R3.*) 

P_address-list  (11,12,13) 

Let's  suppose  that  the  format  used  in  the  present  scheme: 

attribute-list  ((R1.F1),  (R2.F21,  R2.F22),  (R3.F31,  R3.F32,  R3.F33)) 
address-list  (&I1.F1,  &I2.F21,  &I2.F22,  &I3.F31,  &I3.F32,  &I3.F33) 

(where  the  symbol  is  taken  to  mean  "the  address  of") 

The  preprocessor  will  need  to  convert  the  attribute-list(programmer's)  into  the  correct  format.  In 
order  to  perform  this,  we  follow  2 steps: 

1.  Convert  P_attribute-list  (Rl.*,  R2.*,  R3.*)  into 
(R1(F1),  R2(F21,  F22),  R3(F31,F32,F33)) 

2.  Convert  the  result  of  1.  into 

attribute-list  ((R1.F1),  (R2.F21,R2.F22),  (R3.F31,R3.F32,R3.F33)) 

The  preprocessor  will  proceed  to  convert  the  P_address-list  into  the  correct  format: 
address-list  (&I1.F1,  &I2.F21,  &I2.F22,  &I3.F31,  &I3.F32,  &I3.F33) 

During  this  conversion,  the  datatype  would  be  checked.  When  there  is  no  error,  the  output  of  the 
preprocessor  would  be  the  input  for  the  present  scheme  with  datatype  checking  done. 
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Advantages 

The  programmer  need  not  know  about  the  more  complex  nature  of  the  existing  scheme  due  to  the 
ease  in  communicating  with  the  preprocessor.  Hence,  this  scheme  is  more  convenient  and  easier  to 
use.  Errors  are  less  likely  to  happen  and  datatype  checking  is  performed  at  compile-time. 

Hence,  the  safety  of  the  system  is  ensured. 


Functionality 

This  scheme  is  application  specific  and  has  no  impact  on  the  amount  of  space  used.  The  perfor- 
mance of  this  scheme  will  only  be  affected  at  compile-time,  but  it  will  be  the  same  at  run-time. 


2.  Design  2.  (Not  requiring  a special  syntax  for  the  interface) 

This  design  avoids  modifying  the  existing  interface.  It  only  does  type  checking  of  the  elements  of 
the  address  list  with  the  corresponding  elements  of  the  attribute  list. 


Part  IV:  Comparison  of  Design  1 and  Design  2. 


Design  1 modifies  the  interface  to  avoid  several  of  the  problems  identified.  It  keeps  the  program- 
mer from  having  to  deal  with  addresses  etc.  It  solves  the  type  checking  problem  by  creating  an 
interface  where  type  errors  cannot  occur.  However,  it  has  the  disadvantage  that  it  recjuires  the 
programmers  to  learn  an  interface  different  from  the  current  on<j.  It  also  recjuires  a more  complex 
preprocessor. 


Decision 

In  order  to  illustrate  the  power  of  a preprocessor,  we  decided  to  use  design  2.  It  avoided  the  neces 
sity  for  modifying  the  previously  designed  interface,  and  it  kept  the  preprocessor  construction 
simple. 


The  documented  source  code  of  the  preprocessor  is  shown  in  Appendix  A. 

Appendix  A provides  the  preprocessor  design  for  the  RODB  Read/Write  Interface.  It  was  devel- 
oped as  part  of  the  work  on  the  Complex  data  types”  problem.  In  Appendix  A the  assumptions/ 
limitations  of  the  preprocessor  are  presented,  then  we  include  the  source  code,  an  example  input 
and  an  example  output. 
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Performance  Analysis 


The  RODB  and  STSV  software  subsystems  consisted  principally  of  Ada  units  running  under  the 
LYNX  Operating  System  (DMS  - OS)  which  is  an  UNIX-based  Real-Time  Operating  System  (RTOS). 
In  brief,  the  mechanism  of  the  data  transfer  between  an  application  and  DMS  consists  of  two 
mechanisms  of  UNIX  EPC  One  is  the  IPC  Message  Queue  and  the  other  is  IPC  Shared  Memory. 
Shared  memory  enlists  another  so-called  IPC  facility  which  are  the  UNIX  IPC  Semaphores  as  will 
be  explained  later.  The  EPC  Message  Queue  facility  of  UNIX  is  shown  diagrammatically  in  Figure  1 
between  the  API  and  the  Application  Interface  Program  (AIP).  The  latter  runs  under  the  RODB 
Executive  (REX).  The  other  mechanism,  the  IPC  Shared  Memory  (with  semaphores),  is  where  the 
objects  are  stored  and  can  be  accessed. 

In  the  course  of  study  by  Dr.'s  Leibfried,  Zhao,  Davari  and  Natarajan  as  well  as  by  Research  Assis- 
tant Libin  Wu,  it  became  apparent  that  the  performance  of  the  aforementioned  facilities  of  IPC 
Message  Queues  and  Shared  Memory  could  present  the  most  serious  "bottlenecks"  with  the  Em- 
bedded Data  Processor  (EDP). 


1.  IPC  Message  Queue  Performance 


IPC  Message  Queues  are  to  be  used  by  the  DMS  for  the  opening  and  dosing  of  handles  for  read 
and  write  operations.  They  were  originally  also  to  be  used  to  verify  the  validity  of  the  "handle" 
information  possessed  by  the  DMS  when  an  application  wished  to  read  or  write  an  Queue  facility 
was  structured.  Appendix  B contains  a brief  description  of  the  test  program  used  to  estimate  the 
performance  of  IPC  Message  Queues.  Procedure  ROD  B_Test6  is  the  main  program  which  per- 
formed the  test.  To  be  even  more  conservative  and  realistic  two  separate  programs  should  have 
been  constructed  but  in  this  case  RODB_Test6  opened  two  message  queues,  spawned  (forked)  a 
child  process  which  acted  as  a message  recipient  while  the  parent  process  acted  as  the  message 
initiator.  To  simulate  the  RODB  situation  a second  message  acknowledging  the  initial  message  was 
sent  by  the  child  back  to  the  parent  through  the  other  message  queue.  One  supporting  user-defined 
package  for  RODB_Testg6  is  RODB_Test_Data  containing  interface  pragmata  for  C system  calls. 
The  scenario  of  a "round  trip"  of  a message  was  repeated  1000,  2000, 3000, 4000  and  5000  times.  It 
was  assumed  that  5000  times  would  be  the  worst  case  for  an  EDP  since  there  are  to  be  two  Standard 
Data  Processor  (SDP)  Units  on  the  SSF  with  one  EDP  in  each  SDP,  (i.e.  assuming  an  equal  distribu- 
tion of  sensors/effectors  for  each  unit).  Originally  it  was  common  belief  that  most  sensors  attribute 
or  set  of  attributes.  With  this  in  mind  and  considering  the  post-scrub  estimate  of  something  like 
10,000  sensors  and/or  effectors  a simple  test  of  the  performance  of  the  Lynx  IPC  Message  on  the 
SSF  would  be  "read"  every  second  with  some  being  read  or  written  to  several  times  per  second. 
What  the  test  showed,  in  the  worst  case,  this  objective  could  not  be  reached  since  it  took  over  one 
second  to  send  just  1000  round-trip  messages  and  over  six  seconds  to  send  5000  round-trip  mes- 
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sages.  These  times  are  even  optimistic  since  the  PS/2  used  had  a 20  MHz  clock  rate  whereas  the  SSF 
space  qualified  EDP  presently  is  only  listed  as  only  having  a 16  MHz  rate.  Further,  the  test  was  run 
with  no  other  jobs  running  on  the  PS/2  which  will  certainly  not  be  the  case  in  the  operational 
system. 

While  this  result  is  disconcerting,  and  was  so  reported,  it  is  of  less  importance  now  since  the  soft- 
ware developer  (IBM)  presumably  also  realized  the  IPC  Message  Queue  bottleneck  and  has  rede- 
signed the  RODB  component  to  contain  a version  number.  Thus,  the  IPC  Message  Queues  will  be 
used  only  to  open  and  close  read  and  write  handles  and  not  to  verify  the  handle  validity  for  every 
read  or  write.  The  handle  validity  will  be  checked  at  "read  time"  by  comparing  the  version  number 
in  the  handle  with  that  stored  in  the  RODB  component. 

2.  Shared  Memory  Access  Performance 

2(a).  Test  of  Unimpeded  Reads  and  Writes 

Component  writes  respectively.  The  global  data  types  are  defined  in  package 
RODB_Component_Data_Types.  That  package  consists  only  of  data  types  and  global  constants  plus 
interfaces  to  C user-defined  functions  and  system  functions  and  calls.  The  RODB  Component  is 
created  as  shared  memory  by  initialization  code  in  package  RodbComponent  and  three  sema- 
phores are  created  to  "protect"  the  shared  memory  to  enforce  the  Reader-Writer  policy  of  mutual 
exclusion  between  readers  and  writers,  as  well  as  between  two  writers.  Read  access  however  is 
allowed  by  concurrent  readers  using  a UNIX  counting  semaphore.  The  full  effects  of  these  sema- 
phores are  not  used,  however,  in  this  test  since  the  first  program  — Rodbtst81  — only  attempts  to 
accomplish  successive  attribute  reads  from  the  RODB  Component.  Only  the  tests  shown  in  Figure  2 
called  "Attribute  - Read  Flow7'  are  performed  and  the  two  "write"  semaphores  are  never  locked. 

The  data  object  being  read  consists  of  one  of  four  of  the  primitive  attributes,  viz.  Integer,  Character, 
Boolean,  or  Float.  The  actual  one  chosen  for  each  read  is  dependent  upon  the  address  of  the  portion 
of  the  component  being  read.  This  is  much  as  it  is  in  the  proposed  RODB  Component.  Before  the 
read  is  initiated  the  reader  semaphores  are  set  or  incremented.  Specifically,  the  Write_Lock  UNIX 
binary  semaphore  is  tested,  then  if  that  is  not  locked  the  Write_Intent  UNIX  binary  semaphore  is 
tested  and  if  that  is  not  locked  the  Read_Lock  UNIX  counting  semaphore  is  incremented.  What  may 
have  biased  the  results  is  the  fact  that  semaphore  operations  in  the  Lynx  OS.  may  no  longer  be 
atomic  as  is  required  in  normal  UNIX.  To  compensate  for  this,  the  priority  was  raised  to  31  (the 
highest)  just  before  the  semaphores  were  tested  and  set  and  then  the  priority  was  lowered  to  the 
normal  priority  right  after  the  actual  testing  and  set  operations  of  the  semaphores.  These  sema- 
phore operations  are  inside  the  shaded  box  in  Figure  2.  The  actual  code  for  these  semaphore  opera- 
tions are  shown  in  Appendix  C-l  as  C subprogram  readbeg  in  file  readbeg.c  . After  the  actual 
RODB  "read"  the  "readend"  semaphore  operations  are  performed.  The  Read_Lock  UNIX  counting 
semaphore  is  decreased.  If  the  count  goes  to  zero  all  "writers"  sleeping  on  this  event  will  be  awak- 
ened. This  is  also  shown  in  Figure  2.  The  code  for  this  readend  semaphore  operation  is  shown  in 
subprogram  readend  in  file  readend.c.  Here  too  one  can  observe  that  raising  the  process  priority  to 
31  before  the  semaphore  operation  and  lowering  it  after  the  semaphore  operation  guarantees  an 
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the  file  called  rodbcompl  .dal.  The  actual  Read.Attrs  or  read-attributes  program  is  shown  in  appli- 
cation defined  package  Rodb_Component.  The  timing  results  are  also  shown  in  Appendix  C-l 
and  for  our  "typical"  figure  of  5000  successive  read  events  the  total  time  was  about  7 7 seconds 
There  are  a few  things  which  may  bias  these  timing  results.  First,  the  two  semaphore  operations  of 
testing  Wnte.Lock  and  Wntejntent  binary  semaphores  had  to  be  done  twice.  The  reason  being  an 
apparent  deficiency  in  the  Lynx  "semop"  algorithm  in  that  even  though  the  Write  Lock  and 
Wri.e_ln.ent  semaphore  testing  is  done  as  an  array  of  semaphores  the  apparent  operation  does  no, 
fofiow  the  flow  shown  in  Fig.  2.  When  the  process  is  sleeping  on  a locked  Write  Intent  semaphore 
and  then  awakened  because  of  the  Write  .Intern  semaphore  becoming  unlocked  the  semop  algo- 
nthrn  apparently  does  not  retest  the  Write.Lock  semaphore  as  it  should.  To  avoid  this  condition 
t e two  Wnte  tests  were  repeated  in  order  to  get  correct  operation.  This  explains  the  array  elements 
ee<3)  and  four  (4)  in  the  semop  array  m function  readbeg.  A "proof  program  illustrating  this 
deficiency  is  shown  later  in  this  report  and  in  Appendix  E.  Another  minor  item  is  the  read  itself 
t ere  is  a small  amount  of  additional  computation  required  by  the  "if  statement  which  selects 
which  type  of  element  to  read.  Of  course  there  is  the  requirement  for  raising  the  priority  to  guaran- 
tee a omihcity  of  the  semop  or  semaphore  operation  system  call.  Thus  both  the  "readbeg"  and 
readend"  C functions  use  the  fast.setprio  function  to  raise  the  priority  of  the  operation  while  the 
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In  later  programs  these  overhead  items  were  removed  one  at  a time  to  measure  their  contribution  to 
the  overall  performance  time. 

The  writer  performance  is  demonstrated  by  Rodbtst82  and  graphically  illustrated  in  Figure  3 
"Attribute  - Write  Flow"'.  This  test  was  similar  to  the  one  testing  reads  in  Rodbtst81  but  now  the 
intent  was  to  test  the  write  performance  measured  in  a non-interference  condition  where  only 
successive  writes  to  the  RODB  Component  took  place.  The  secjuence  is  essentially  the  same  except 
that  the  write  semaphores  instead  of  the  reader  semaphore  operations  were  invoked.  The  writebeg 
or  write-begin  C program  first  activates  the  Write Jntent  or  WWRITE_DESIRE  binary  semaphore, 
then  it  does  semaphore  operations  on  an  array  of  semaphores,  namely;  testing  the  Read_Lock 
semaphore,  increasing  or  locking  the  binary  Write_Lock  semaphore  and  the  Read_Lock  counting 
semaphore  as  well  as  decreasing  or  unlocking  the  Write_Intent  or  WWRITE_DESIRE  semaphore. 
This  last  array-of-semaphores  operation  is  diagramatically  shown  in  the  shaded  border  area  of 
Figure  3.  The  Write_Attrs  or  Write- Attributes  procedure  in  package  Rodb_Component  then  does 
the  actual  write  to  the  RODB  Component.  Following  that,  the  writeend  C function  is  invoked  to 
decrease  the  Read_Lock  counting  semaphore  and  unlock  the  Write_Lock  semaphore.  This  process 


Figure  3.  Attribute  - Write  Flow 
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is  repeated  for  1000,  2000, ...  ,10000  times.  The  time,  for  the  anticipated  worst  case,  5000  object 
writes  took  8.78  seconds.  The  same  comments  about  overhead  apply  to  this  experiment  as  for  the 
"read"  test. 

Appendix  C-2  contains  essentially  the  same  programs  as  in  Appendix  C-l  with  the  exception  that 
the  raising  and  lowering  of  process  priority  to  guarantee  the  atomicity  of  operation  of  the  sema- 
phores is  eliminated,  i.e.  commented  out.  The  results  of  Rodbtst91  for  the  same  5000  reads  now 
drops  to  2.57  seconds.These  results  are  documented  in  rodbcomp91.out  and  rodbcomp92.out 
respectively  in  Appendix  C-2.  Corresponding  performance  time  for  the  5000  writes  now  takes  3.58 
seconds.  The  drop  in  each  case  of  over  five  (5)  seconds  indicates  that  even  with  the  so-called 
fast_setprio  function  call,the  overhead  for  raising  process  priority  is  high.  This  would  seem  to 
indicate  that  if  the  Lynx  semaphore  system  calls  could  support  semaphore  integrity  without  effec- 
tively disabling  preemption  of  interrupts  — by  raising  priority  — it  should  be  done.  This  test  pro- 
gram is  not  truly  valid  since  it  reads  four  attributes  rather  than  one  but  that  is  most  probably  more 
than  compensated  for  by  the  fact  that  there  would  be  more  things  occupying  the  processor  than  just 
RODB  reads  or  writes  in  a practical  situation.  Clearly  a one-second  attribute  read  cycle  for  so  many 
RODB  reads  with  one  386  processor  is  hardly  realistic. 

In  Appendix  C-3  the  programs  are  the  same  as  C-l  but  this  time  the  semaphore  operations  are 
commented  out.  This  is  not  a practical  solution  but  it  was  run  to  try  to  determine  the  performance 
without  the  semaphore  operations.  The  results  for  RodbtstAl  the  same  "typical"  5000  reads  was  5.0 
seconds  and  for  the  writes  the  performance  time  was  approximately  5.3  seconds.  Raising  priority  is 
a way  to  guarantee  mutual  exclusion  but  at  a high  price.  It  effectively  causes  a "no-preemption" 
condition  in  the  system  guaranteeing  atomiticity  of  the  reads  and  the  writes  just  as  might  be  ex- 
pected with  conventional  UNIX  where  the  Kernel  cannot  be  preempted.  The  resulting  performance 
penalty  is  too  high  for  a real-time  operating  system. 

In  the  Appendix  C studies  concurrency  was  not  tested,  so  the  performance  time  results  of  Appen- 
dix C-l  almost  exactly  sum  up  to  the  results  of  C-2  plus  C-3.  This  was  to  be  expected  because  of  the 
absence  of  multiprogramming. 

A more  realistic  program  testing  the  mutual  exclusion  raising  the  process  priority  would  do  so 
just  before  the  read  and  would  lower  it  right  after  the  read  respectively  rather  than  using  this 
effective  disabling  of  preemption  twice  to  guarantee  the  atomicity  of  the  semaphore  operations. 
Similarly  an  analagous  program  to  test  writes  would  do  the  same  thing.  Such  a program  is  shown 
in  Appendix  C-4.  The  results  of  this  scenario  with  procedure  RodbtstBl  shows  that  the  same 
benchmark  of  5000  read  cycles  took  2.28  seconds  and  the  corresponding  5000  write  cycles  took  2.21 
seconds.  This  clearly  shows  that  the  system  call  to  set  a process  priority,  even  the  so-called  "fast" 
changing-of-priority  algorithm  (i.e.  fast_setprio)  is  costly.  Wherever  possible  dynamic  priority 
changes  should  be  avoided  or  at  least  minimized.  Apparently,  doubling  of  the  number  of 
fast_setprio  operations  had  the  effect  of  raising  the  execution  time  over  100%.  That  is  from  2.28 
seconds  for  5000  reads  to  5.0  seconds  as  found  in  the  programs  in  Appendix  C-3  . 
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Finally,  in  Appendix  C-5  the  programs  RodbtstCl  (reads)  and  RodbtstC2  (writes)  were  modified 
versions  of  this  series  where  raw  "reads"  and  "writes"  were  accomplished  wihout  any  critical  sec- 
tion protection.  That  is  to  say  no  disabling  of  preemption  nor  semaphores  were  used.  The  resulting 
time  for  the  benchmark  5000  read  cycles  or  write  cycles  was  on  the  order  of  0.4  seconds.  These 
operations  were  essentially  non-competing  in  that  the  read  cycles  and  write  cycles  were  tested 
separately. 

The  tests  in  this  section  clearly  indicate  that  the  semaphore  and  preemption  disabling  and  enabling 
operations  are  very  cosly  in  relationship  to  the  basic  read  and  write  operations. 


2(b).  Test  of  Concurrent  and  Competing  Reads  and  Writes 

In  Appendix  D-l  procedure  RodbtstDl  contains  three  tasks  which  all  are  of  the  same  priority,  two 
of  them  are  reader  tasks  and  one  is  a writer  task.  The  support  packages  and  programs  are  essen- 
tially the  same  as  for  Appendix  B. 

That  is  to  say; 

package  Rodb_Component_Types, 

package  Rodb_Component, 

function  readbeg, 

function  readend, 

function  writebeg, 

function  writeend 

function  semsinit, 

function  semsrmv, 

function  semprint, 

and  a new  package  called  RODB_Test_Datal. 

With  the  algorithm  for  each  task  in  RodbtstDl  essentially  duplicating  the  code  used  in  Rodbtst81  or 
Rodbtst82  these  Reader  tasks  competed  with  the  Writer  task  for  access  to  the  RODB  Component.  In 
this  test  the  readers  accessed  the  RODB  Component  2500  times  each  and  the  writer  accessed  the 
same  Component  5000  times.  In  this  case  the  writer  "serviced"  two  readers.  The  elapsed  time  for  all 
these  reads  and  writes  to  complete  was  approximately  19  seconds.  This  time  is  the  largest  of  the 
times  of  the  three  tasks  competing  to  read  or  write.  As  one  might  suspect  the  writer  logged  the 
greastest  elapsed  time.  It  must  be  remembered  that  each  task's  priority  was  essentially  raised  to  do 
the  requisite  semaphore  operations  and  lowered  after  they  were  completed  to  guarantee  the  atomic 
operations  of  the  semaphores  and  this  "fast_setprio"  was  done  twice  for  each  read  or  write. 

In  Appendix  D-2  the  same  program  as  in  AppendixD-1  was  executed  except  that  the  code  raising 
and  lowering  of  the  priorities  to  guarantee  atomic  semaphore  operations  was  discarded  (i.e.  com- 
mented out).  In  that  case  the  greatest  elapsed  time  to  access  the  RODB  Component  by  two  readers 
for  2500  reads  each  and  for  5000  writes  by  the  writer  took  6.98  or  approximately  seven  (7)  seconds. 
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It  is  clear  that  the  overhead  of  raising  and  lowering  of  priorities  is  costly  since  there  is  roughly  a 
twelve  (12)  second  difference  in  the  performance  times.  The  raising  and  lowering  of  the  priorities 
almost  tripled  the  maximum  time  for  all  of  the  tasks  to  finish.  It  seems  clear  that  the  price  for 
compensating  for  the  perceived  deficiency  in  operating  system  services  is  too  high.  Effort  could 
well  be  justified  in  correcting  deficiencies  rather  than  attempting  "band-aid"  compensation  of  them. 

In  AppendixD-3,  for  completenes,  the  code  and  corresponding  data  files  are  included  for  the  case 
of  no  semaphores  and  no  dynamic  priority  changes  protecting  the  reads  of  the  RODB  Component. 
The  "raw"  reads  and  writes  took  on  the  order  of  two  (2.13)  seconds  to  complete  5000  each  of 
concurrent  reads  and  writes.  When  the  number  of  reads  was  increased  to  10000,  the  time  to  com- 
plete all  the  reads  and  writes  took  about  four  seconds  (4.06).  The  main  program  in  Appendix  D-3 
was  renamed  RodbtstFl  to  distinguish  its  characterisitics. 


3.  Test  of  Mutual  Exclusion  for  the  Reader-Writer  Problem 

Appendix  E contains  the  code  which  is  similar  to  that  of  the  programs  in  Appendix  C in  that  it 
simulates  the  Reader-Writer  problem  where  multiple  readers  may  read  even  the  same  attribute  of 
an  RODB  object  at  the  same  time  but  readers  and  any  writer  must  access  the  RODB  mutually 
exclusively.  That  is  to  say  a writer  and  a reader  may  not  access  the  same  attribute  at  the  same 
(concurrent)  time  nor  may  two  writers  access  the  same  attribute  at  the  same  time.  In  other  words, 
by  design,  there  is  to  be  mutual  exclusion  between  readers  and  writers  and  between  different 
writers,  but  no  mutual  exclusion  between  different  readers.  The  results  of  this  test  showed  that 
there  was  indeed  a violation  of  the  mutual  exclusion  principle  using  the  Lynx  version  of  UNIX 
semaphores.  These  results  cast  a shadow  on  the  results  of  the  performance  times  of  the  competing 
reads  and  writes  of  Appendix  D.  These  times  might  be  too  optomistic  if  readers  and  writer  were 
allowed  concurrent  access  to  a given  RODB  component  element  when  there  should  have  been 
mutual  exclusion.  The  main  program  is  called  Rodb_Test7.  This  program  does  not  use  tasks  since  it 
only  does  one  read  or  write.  There  are  common  packages  with  the  Rodbtst80  and  Rodbtst90  series 
used  by  Rodb_Test7.  These  are  the  packages  RODB_Component_Data_Types  and 
RODB_Component.  The  C programs  used  are  vitually  identical  to  those  used  in  Appendix  D-2, 
(main  program  RodbtstEl).  That  is  to  say  the  array  of  semaphore  operations  used  are  the  same  but 
no  set-priority  system  calls  (i.e.  setprio)  are  used. 

What  the  programming  system  of  Rodb_Test7  does  is  to  set  up  an  RODB  component  shared 
memory  segment  and  then  permit  the  user  to  request  either  to  read  (reader)  or  to  write  (writer)  to 
that  shared  memory.  The  semaphore  operations  are  handled  by  the  readbeg,  writebeg,  readend  and 
writeend  C function  programs.  The  flow  of  these  semaphore  operations  are  shown  in  the  Figure  2, 
the  Attribute  Read  Flow  and  Figure  3,  the  Attribute  Write  Flow. 

The  shaded  box  regions  shown  in  these  diagrams  indicate  the  operations  which  must  be  performed 
as  an  atomic  transaction.  What  this  translates  to  is  the  fact  that  if  the  kernel  "sleeps"  at  any  point 
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within  these  "boxes",  it  must  then  retest  all  the  semaphores  from  the  beginning  of  the  flow  through 
the  box  in  questionwhen  it  resumes.  This  fact  is  also  evident  from  Figure  4 which  shows  the  algo- 
rithm for  the  semop  system  call,  (see  Bach  [4]).  The  algorithm  clearly  shows  the  "go  to  start"  or 
loop-back  to  the  enty  point  of  the  algorithm  upon  any  "wakeup".  Rodb_Test7's  code  permits  it  to 
act  as  either  a reader  or  a writer  process.  The  writer  process  code  incorporates  a pause  statement  in 
the  writebeg  function  subprogram  just  after  completing  the  semaphore  operation  and  just  before 
entering  the  "box"  with  the  notation  "Access  the  RODB  Component  to  WRITE".  This  causes  the 
writer  process  to  stall  inside  its  critical  section. 

When  that  happens,  any  reader  which  is  sleeping  (waiting)  for  either  the  Write_Lock  or  the 
Write_Intent  semaphore  to  be  cleared  should  sleep  for  at  least  as  long  as  the  writer  pauses,  which  is 
indefinite.  What  we  found  to  happen  is  that  any  reader  sleeping  on  the  Write_Intent  semaphore 
will  awaken  when  the  Write_Intent  semaphore  is  cleared  but  will  not  loop  back  to  "start"  and  test 
the  Write_Lock  semaphore  but  will  continue  by  increasing  the  Read_Lock  semaphore  and  enter  its 
critical  section  to  access  the  RODB  Component.  To  show  this,  Rodb_Test7  must  be  invoked  concur- 
rently three  times  from  three  different  terminals.  The  first  process  should  be  invoked  as  a reader, 
the  second  as  a writer  and  the  third  as  another  reader.  Under  the  scenario,  the  third  process  or 
second  reader  should  block  at  the  Write_Lock  semaphore  and  never  finish  because  of  the  "pause" 
of  the  writer.  Unfortunately  what  is  observed  is  that  the  third  process  does  finish  even  though  the 
writer  is  still  blocked  at  its  pause  statement.  The  full  details  of  the  test  are  described  in  the  read.me 
file  in  Appendix  E. 

The  results  of  this  test  lead  to  the  assertion  that  if  the  reader-writer  problem  is  to  be  properly  ad- 
dressed serious  consideration  must  be  given  to  correcting  the  deficiency  of  the  semop  algorithm  in 
the  Lynx  Operating  System.  In  fact  just  adjusting  the  algorithm  to  meet  the  normal  AT&T  UNIX 
System  V performance  may  be  insufficient  for  the  real-time  operations  needed  for  Space  Station 
Freedom.  The  semop  algorithm  relies  upon  the  policy  that  the  UNIX  Kernel  is  non-preemptible  this 
is  counter  productive  to  real-time  operation  [4],  Lynx  has  a preeptable  Kernel  [6].  If  in  Figure  2 , 
Attribute  Read  Flow  the  Kernel,  running  in  behalf  of  a first  reader  process,  is  preempted,  say  just 
before  the  point  where  it  will  increase  the  reader  counting  semaphore  to  lock  out  a writer,  when  it 
resumed,  it  might  not  normally  be  cognizant  that  it  had  been  preempted  and  the  typical  protocol 
would  be  to  continue  from  whence  it  stopped  execution.  This  could  be  disasterous  if  a preempting 
writer  process  also  accessed  the  same  RODB  Component  attribute.  Mutual  exclusion  would  again 
be  violated.  Clearly  some  reexamination  of  the  structuring  of  semaphore  algorithms  in  Lynx 
should  be  mandatory  if  the  precept  of  a preemptable  kernel  is  to  be  maintained  and  a set  of  sema- 
phores which  must  maintain  atomic  operations  is  necessary. 
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algorithm  semop  /*  semaphore  operations*/ 
inputs:  (1)  semaphore  descriptor;  (2)  array  of  semaphore  operations 
(3)  number  od  elements  in  the  array; 
output:  start  value  of  last  semaphore  operated  on 
{ check  legality  of  semaphore  descriptor; 
start:  read  array  of  semaphore  operations  from  user  to  kernel  space; 

check  permissions  for  all  semaphore  operations; 
for  (each  semaphore  operation  in  the  array) 

{ if  (semaphore  operation  is  positive) 

{ add  "operation"  to  the  semaphore  value; 

if  (UNDO  flag  is  set  on  the  semaphore  operation) 
update  process  undo  structure; 

wakeup  all  processes  sleeping  (event  semaphore  value  increases); 

} 

else  if  (semaphore  operation  is  negative) 

{ if  ("operation"  + semaphore  value  >=  0) 

{ add  "operation"  to  semaphore  value; 
if  (UNDO  flag  set) 

update  process  undo  structure; 
if  (semaphore  value  is  0) 

wakp  all  processes  sleeping  ( event 

semaphore  value  becomes  0); 

continue; 

) 

reverse  all  semaphore  operations  already  done  on  this  system  call 

( i.e.  on  previous  iterations) 
if  (flags  specify  not  to  sleep)  return  with  error; 
sleep  (event  semaphoree  value  increases); 

go  to  start;  /*  start  loop  from  the  beginning  (nested  transaction)*/ 

} 

else  /*  semaphore  value  is  0 */ 

{ if  (semaphore  value  is  not  0) 

{ reverse  all  semaphore  operations  done  this  system  call; 
if  (flags  specify  not  to  sleep)  return  with  error; 
sleep  (event  semaphore  value  ==  0);  go  to  start; 

) 

} 

} /*  for  loop  ends  here  */ 

update  time  stamps,  process  ED's ; /*  semaphore  opedrastions  succeeded  */ 
return  value  of  last  semaphore  operated  on  before  call  succeeded; 

} 


Figure  4.  Algorithm  for  Semaphore  Operation 
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Summary  of  Observations 
and  Suggestions 


The  study  and  analysis  done  under  this  so-called  Complex  Data  Types  project  has  of  necessity  been 
limited  to  attacking  what  seemed  to  be  the  salient  features  of  the  Data  Mangement  System  for  Space 
Station  Freedom.  Two  distinct  areas  were  investigated.  One  was  the  problem  anticipatedby  the 
necessary  circumvention  of  the  strong  typing  features  of  Ada  by  the  RODB.  What  was  postulated 
was  the  concept  of  a preprocessor  to  capture  the  deficiencies  of  any  code  which  might  have  inter- 
face irregularities.  The  structuring  of  a simple  preprocessor  showed  what  was  anticipated.  The 
MODB  will  need  to  have  a strict  naming  convention  in  order  to  enable  any  automatic  mechanism 
for  correcting  any  program  interface  errors.  The  other  area  was  performance  of  RODB  STSV  soft- 
ware in  a real-time  environment.  With  the  limited  resources  at  hand  only  the  salient  concepts  of  the 
anticipated  major  problem  areas  could  be  addressed.  Two  such  areas  were  the  IPC  message  queues 
for  setting  up  RODB  reads  and  writes  and  the  mutual  exclusion  problem  for  protecting  the  integrity 
of  critical  data  areas  in  the  RODB  Component  itself.  Performance  problems  were  identified  with 
both  the  UNIX  IPC  Message  Queue  and  Semaphore  constructs  and  a serious  integrity  problem  was 
found  with  the  semaphores. 

The  study  results  did  identify  potential  problem  areas  for  further  investigation  and  indicate  a 
direction  for  possible  solutions  to  these  problems.  Even  though  final  solutions  were  not  defined,  the 
identification  of  the  deficiencies  of  resources  which  need  to  be  used  to  satisfy  the  perceived 
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ABBREVIATED  APPENDICES 
APPENDICES  A,B,C-1,  D-1,  E 


Appendix  A 


Ada  Preprocessor 


Preprocessor  Version  0.5 


Changes  from  version  0.4 

User  enters  input  and  output  filenames. 

Ignores  comments  better  (hopefully  completely) 

List^pack  doesn't  allocate  storage  until  actually  needed. 


Assumptions/limitations: 

--  1.  Input  and  Output  must  be  different  files. 

2.  Correct  Syntax.  ( input. ada  must  be  a compilable  Ada  program) 

3.  Flat  name  space  in  input . ada 

4.  The  read_open  calls  and  all  of  its  associated  attribute  read  calls 
are  in  input. ada. 

5.  The  specification  and  body  of  read_open  and  attribute  read  are 
given  in  another  routine  (ie:  'with'ed  from  a package) 

" 6.  Each  read__open  will  use  a distinct  handle. 

7.  Each  attribute^read  uses  only  one  handle  (not  a list)  . 

8.  The  handle  in  an  attribute_read  is  the  exact  name  given  in 
corresponding  read_open . 

9.  The  syntax  of  the  read_open  and  attribute_read  is  just  like 
that  in  the  CDR  document,  (except  no  list  of  handles) . 

10.  This  routine  produces  new  Ada  code,  which  must  then  be  seperately 
compiled. 

11.  package  'dummyjpack'  is  created.  (decreased  name  space) 

" 12.  A MODB  routine  is  simulated  in  the  preprocessor  - when 

given  the  name  of  an  attribute,  returns  the  type  of  that 
attribute. 

13.  The  first  begin  in  the  file  is  the  begin  of  the  main  program. 

This  was  necessary  since  the  best  place  to  put  dummy r>ack  just  before 
it.  (there  are  ways  around  this  - as  well  as  several  of  the  above) 


This  is  the  simulated  MODB  package  and  function  call 


package  MODB^package  is 

function  Get_type  (What  : in  String)  return  String; 

end  MODB_package ; 


I 


package  body  MODB_package  is 

an  attribute  namec  return  the  corresponding  type 

function  Get_type  (What  : in  String)  return  Strinq  is 

begin  ~ 

if  (What  - "AP_TELESCOPE.X  POSITION")  then 
return  "X_POSITION  T"; 

elsif  (What  = "AP_TELESCOPE.Y  POSITION")  then 
return  " Y_POSITION_T" ; 
elsif  (What  = "AP_TELESCOPE. SHUTTER")  then 
return  "SHUTTER_POSITION  T"; 
elsif  (What  = nAP_TELESC0PE7RIGHT  ASC")  then 
return  "RIGHT_ASCENSION  T";  - 

elsif  (What  = "AP_TELESCOPE. DECLINATION")  then 
return  "DECLINATION  T"; 

elsif  (What  - "APJTELESCOPE.DEC  DEGREES")  then 
return  " DECL I NAT I ON_DEGREES  T"; 
elsif  (What  - "AP_TELESCOPE.DE^  MINUTES")  then 
return  " DECL I NAT I ON_M INUTES  T" ; 
elsif  (What  - " AP_TELESCOPE . DEC  SECONDS")  then 
return  "DECLINATION  SECONDS  T" ; 
elsif  (What  - "AP_TELE3COPE . STATE" ) then 
return  "STATE  T"; 
else  ~~ 

return  "Unknown  type"/ 
end  if;  ~~ 

end  Get _t ype; 
end  MODB_package ; 


--  package  LIST_PACK 

generic  list  package  that  must  be  instantiated  with 
~ a aata  type . 

- Unconstrained  array  type  'list  type'  is  made  available  as  a 
private  type.  The  'wither'  sKould  create  a list  of  this 
type  and  pass  it  back  as  a parameter  to  the  calls  in  this 
package.  It  was  done  this  way  so  that  several  lists  can  be  worked  on 
by  each  instantiation,  while  still  keeping  the  workings  of  the 
~ lists  private. 


with  Text_io;  use  Text_io; 
Generic 

type  Item_type  is  private; 
package  List_pack  is 


! 


l 


This  is  the  type  that  is  used  by  'wither'  to  create  a list, 
type  L i s t_t ype ( Max : Natural)  is  private; 


function  S i ze^_of  (Lister  : in  List  type)  return  I 
function  Get  item(Offset  : Integer;  Lister  : in 

procedure  Ad3_it  em  { I tern : in  Item_type;  Lister  : 
procedure  Update__item  ( Item : in  Item  type;  Lister 

Offset  : Natural) ; 


nteger ; 

List_type)  return  Item 
in  out  List  type) ; 

: in  out  LTst  type; 


t ype ; 


private 

type  Item_pt r_type  is  access  Item_type; 


type  List_array  is  array  ( Integer  range  <>)  OF  Itemj)tr  type; 
type  List_type (Max : Natural  ) is 
record 

List  : List_array (0 . . Max) ; 

Num_in  : Integer  :=  0; 

end  record; 

end  Listj>ack; 


Body 


package  BODY  List_pack  is 

i 

— 
--  Add  to  the  list 


procedure  Add^item (Item : in  Item_type;  Lister  : in  out  List  type)  is 
begin  ~ 

if  Lister . Num_in  =*  Lister. Max  then 

Put("  ERROR:  List^pack . Add_item : Lister  of  items  is  full  - didn't  add") 

else 

Lister . List (Lister . Num_in)  new  Item_type' (item) ; 

Lister .Num_in  Lister . Num^in  + 1; 

end  if; 
end  Add  item; 


--  Update  an  Item 


procedure  Update__item(Item:  in  Item_type;  Lister  : in  out  List  type; 

Offset  : Natural)  is 

begin 

if  Lister . Num_in  < Offset  then 

Put("  ERROR:  List_jpack . Update^item : offset  out  of  current  range")  ; 
else 

Lister  . List  (Of  fset  - l).all  : =*  Item; 
end  if; 

end  Update_item; 


— Return  (without)  deleting,  the  item  at  a particular  offset 


function  Get_item (Of f set  : Integer;  Lister  : in  List_type)  return  Item_type  i 
begin  — 

if  Lister . Num_in  * 0 then 

Put (n  ERROR : Lis t__pack . Get  item:  Lister  of  items  is  empty-  can't  retrieve") 
elsif  Offset  > Lister. Num  Tn  then 

Put  ("  ERROR:  List^pack . (5et_item : not  that  many  items  - can't  retrieve"); 

else 

return  Lister . List (Of fset  - l).all; 
end  if; 
end  Get  item; 


--  Returns  how  many  items  are  currently  in  the  list 


function  S ize_of  ( Lister : in  List__type)  return  Integer  is 
j begin 

return  Lister . Num_in; 
end;  ~~ 

i end  List_pack; 


package  inout_pack 


This  is  a package  to  handle  ail  reading  from  the  input  file  and 
writing  to  the  output  file 

Upon  instantiation,  the  input  and  output  files  are  opened 
Right  now,  they  are  static  filenames 


with  Text_io;  use  Text  io; 
package  Inout_pack  is 


— Supply  types  and  max  lengths  for  the  'words'  returned  each 
call  to  get_word 

Max_name_len  : constant  80; 

subtype  Name_len_type  is  Integer  range  O..Max_name  len; 
subtype  Name_type  is  String ( 1 . . Max_name  len);  ~ 


Declare  a word  type  to  be  a name  type  and  a current  length 
Didn't  make  it  private  because  oT  the  plethora  of  times 
the  individual  fields  are  used  elsewhere. 

type  Word_type  is 
record 

Name  : Name  type; 

Len  : Name_Xen  type; 
end  record;  ~ 

function  Get_next__word  return  Word  type; 
procedure  Put_f  (What  : in  String)? 
procedure  Put_line_f  (What  : in  String  : 
procedure  Reset  input; 

function  Open_f  Ties  ( inn_f  name,  out_f name  : 
end  Inout_pack;  “ 


"")  ; 

string)  return  boolean; 


package  BODY  Inout_pack  is 

Innf  : File_type; 

Outf  : File_type; 

Lookahead  : Character  :»  Ascii. nul;  --  next  character  in  the  input 


resets  the  input  file  back  to 

the  beginning 

of  the  file 

procedure  Reset_input  is 
begin 

Reset ( Innf)  ; 

Lookahead  Ascii. nul; 

end; 

Outputs  a string  to  the  output 

file 

procedure  Put  f (What  : in  String) 
begin 

^Put (Outf, What) ; 
end  Put  f; 

i s 

Outputs  a string  and  new  line 

to  the  output 

file 

" " ) is 


procedure  Put_line_f  (What  : in  String  :» 
begin 

Put_line (Out  f , What)  ; 
end  Put  line  f; 


Scans  the  input  file.  Returns  the  next  'word' . Entire  comments 
are  passed  back  as  words.  Blanks,  line  feeds,  etc.  are  passed 
back  as  one  character  long  words. 

Passes  back  an  ascii. nul  and  length  of  0 on  end-of-file 
It  finds  a single  word  by  stopping  at  blanks,  etc.  This  stop 
character  is  stored  in  the  internal  (to  body)  variable 
called  lookahead.  Lookahead  is  then  used  as  the  first  character 
on  the  next  call 


function  Get_next_word  return  Word_type  is 
Word  : Word_type; 

Char  : Character; 

Cnt  : Integer; 


The  following  to^upper  was  taken  out  of  the  Verdix  library 


type  convert_t  is  array (character ) 
to_jupper:  constant  convert_t  ( 
ascii. nul,  ascii. soh, 
ascii.eot,  ascii. enq, 
ascii. bs,  ascii. ht, 
ascii. ff,  ascii. cr, 
ascii. die,  ascii. del, 
ascii. dc4,  ascii. nak, 
ascii. can,  ascii. em, 
ascii. fs,  ascii. gs 

t t t \ t 
f 

')' 

' 1' 

' 9' 


of  character; 


r (' 
r 0' 
r 8' 
' 0' 
' H' 
r P' 
r X' 

f \ r 

' H' 
P ' 
X' 


tut 
t it  t 

'2' 


' A' 
' I' 

' Q' 
' Y' 
'A' 
' I' 
' Q' 

' Y' 


' B' 
' J' 
'R' 
' Z' 
' B' 
' Jf 
' R' 
' Z' 


'C' 

'K' 

'S' 

' {' 
'C' 
'K', 
'S', 


ascii . 
ascii  . 
ascii . 
ascii . 
ascii . 
ascii . 
ascii . 
ascii . 

'%' 
* f — t 
t 

' 5' 


4', 
<'  , 
D'  , 
L'  , 
T'  , 
V, 
D'  , 
L'  , 
T'  , 


'E' 

'M' 

'U' 

'E' 
'M' 
'U' 
' }' 


stx,  ascii. etx, 
ack,  ascii. bel. 
If,  ascii. vt, 
so,  ascii. si, 
dc2,  ascii. dc3, 
syn,  ascii. etb, 
sub,  ascii. esc, 
rs,  ascii. us, 

t e t t t r 
t « r t 

t t t / 1 

t if 

'6',  '7', 

'F',  'G', 

'N',  'O', 

' V'  ' W' 


F',  'G', 

N',  'O', 

V'  , 'W', 

’ , ascii . del ) ; 


Gets  the  next  character 


function  Get_char  return  Character  is 
Temp__char  : Character; 
begin 

if  End_of_f ile ( Innf ) then 
return  Ascii. nul; 
elsif  End  offline ( Innf ) then 
Skip_lTne ( Innf) ; 
return  Ascii. If; 
else 

Get (Innf, Temp_char) ; 
return  to_upper (Temp_char ) ; 
end  if; 
end  Get_char; 

begin 

if  (End_of_f ile ( Innf ) ) AND  (Lookahead  = Ascii. nul)  then 
WordTLen  ; - 0; 


Lookahead  : = Ascii. nul; 
else 

if  Lookahead  = Ascii. nul  then 
Word . Name ( 1 ) : » Get  char; 

else 

Wo  rd . Name ( 1 ) :=  Lookahead; 

end  if; 

Word . Len  : =*  1 ; 


- Found  the  start  of  a word,  get  rest  of  word 

if  (Lookahead  in  9 A'  , . ' Zf ) then 
loop 

Char  :=  Get^char; 

exit  when  (Char  not  in  'A'.. '2')  AND 

(Char  not  in  '1' ..'9')  AND  (Char  /=  ' 
Word. Len  : * Word. Len  +1;  ~ 

Word. Name (Word. Len)  :«  Char; 
end  loop; 

Lookahead  Char; 


_I  t°°^  t?u*ee  uf  ifc  iS  a comroent/  if  so  get  entire  comment 
To  do  this,  have  to  read  next  character.  if  it  is  not 
a minus,  pass  the  first  back  this  time  as  word(l)  and 
store  the  second  in  Lookahead 

elsif  (Lookahead  - ' ) then 
Char  Get  char; 
if  (Char  - 7“-f)  then 
Word. Len  2; 

Word. Name (Word. Len)  :«  Char; 

1 ^ne  ( I nnf , Word  . Name  ( 3 . . Word . Name 9 last)  , Cnt ) * 

Word. Len  : - Cnt ; 

Lookahead  Ascii. If; 
else 

Lookahead  Char; 
end  if; 


else  just  pass  that  one  character  back  as  word(l) 
" next  character  to  the  lookahead 


and  get 


else 

Lookahead  :»  Get_char; 
end  if;  " 

end  if; 


return  Word; 
end  Get_next  word; 

function  Open_files (inn_fname, out_fname  : string)  return  boolean  is 
begin 

Open  { Innf , in__f  ile,  inn_f  name)  ; 

Create  (Out f , out_f ile,  out  fname)  ; 
return  true; 
exception 

when  others  =>  return  false; 
end; 

end  Inout  pack; 


procedure  PROCESS 

This  is  the  main  preprocessor  routine 


with  Text_io;  use  Text_io; 

with  List_pack;  --  Generic  list  package 

with  Inout_pack;  use  Inout_pack;  --  Package  to  handle  all  I/O 

--  includes  definitions  for  Words,  etc. 
--  'Used'  it  because  it  is  used  so  often 

with  MODB_Package; 
procedure  Preprocess  is 


These  set  upper  bounds  on  the  number  of  read_opens,  attribute_reads 
and  the  number  of  components  in  an  attribute  or  address  array 

Max_num_opens  : constant  Integer  20; 

Max_num__reads  : constant  Integer  100; 

Max_items  : constant  Integer  : — 20; 

Dummy_j5ack_name  : constant  String  "dununy^jpack" ; 


Set  up  a list  of  Words  so  that  it  can  be  used  to  hold  the  parameters 
to  the  read_opens  and  attribute  reads 

package  Word_j>ack  is  NEW  List_pack  (Word_type)  ; 


— Set  up  a list  of  read^open(s) , each  of  which  has  a Handle  name, 
attribute  list  name,  and  a list  to  store  the  actual  fields  in 
the  attibute  list  - filled  in  on  second  pass 

Type  Open_type  is  record 

Handle  : Word  type  : * ((others  ->  ' '),0); 

Ary_id  : Wor3  type  ((others  ->  ' ' ) , 0 ) ; 

Ary  : Word^paclc . List^type  (Max_items)  ; 
end  record;  “ 

package  Open__pack  is  NEW  List^pack  (Open  type)  ; 

Open_list  : Open_pack  . List__type  (Max_num”opens ) ; 


Set  up  a list  of  attribute_read ( s ) , each  of  which  has  an 
address  list  name  and  a list  to  store  the  actual  fields  in 
— the  address  list  - filled  in  on  second  pass 

Type  Read_type  is  record 

Ary_id  : Word_type  ( (others  ->  ' ' ) , 0) ; 

Ary  : Word_pack . Lis t_type (Max_i terns ) ; 
end  record; 

package  Read_pack  is  NEW  List_pack (Read_type) ; 

Read_list  : Read _jsack . Lis t_type (Max_num  reads); 


--  Search  through  the  list  of  at t r ibute_reads  for  an  address  parameter 
--  that  is  equal  to  Word.  Return  its  Index  if  found,  zero  otherwise 


function  Srch__read__Ary_id  ( Word  Word_type)  return  Integer  is 
Temp_read  : Read_type; 
begin 

FOR  Index  in  1 . .Read_pack . Size_of (Read_list ) loop 


Temp_read  Read_pack  . Get_item  ( Index  , Read  list)/ 
if  (Temp_read.Ary_id.Len  =*  Word.Len)  — 

and  (Temp  read . Ary_id . Name ( 1 .. Word . Len) 

* Wor3 . Name ( 1 .. Word . Len) ) then 
return  Index; 
end  if; 
end  loop; 
return  0; 
end; 


Search  through  the  list  of  read^_opens  for  an  attribute  parameter 
that  is  equal  to  Word.  Return  Tts  Index  if  found,  zero  otherwise 


function  Srch_open_Ary_id (Word : Word_type)  return  Integer  is 
Temp_open  : Open_type; 
begin 

FOR  Index  in  1 . . Open_j>ack . Size_of (Open_list ) loop 
Temp_open  :«  Openjpack . Get_item ( Index, Open_list ) ; 
if  (Temp_open . Ary_id. Len  - Word.Len) 

and  (Temp  open . Ary_id. Name ( 1 .. Word . Len) 

* Wor3. Name ( 1 .. Word. Len) ) then 
return  Index; 
end  if; 
end  loop; 
return  0; 
end; 


Search  through  the  list  of  read  opens  for  a Handle  parameter 
that  is  equal  to  Word.  Return  its  Index  if  found,  zero  otherwise 


function  Srch_open_Handle ( Word : Word_type)  return  Integer  is 
Temp_open  : Open_type; 
begin 

FOR  Index  in  1 . .Openjpack . Size_of (Open_list)  loop 
Temp_open  :=  Open  pack . Get_item ( Index,  Open  list); 
if  (Temp_open . HanHle , Len  - Word.Len)  ~ 

and  (Temp  open . Handle . Name ( 1 .. Word . Len) 

“ Wor3. Name < 1 . .Word. Len) ) then 
return  Index; 
end  if; 
end  loop; 
return  0; 
end; 


Outputs  the  complete  dummy  package  with  procedures  for  each  valid 
Handle  along  with  the  appropriate  formal  parameters 


procedure  Write_package  is 
Param_name  : String ( 1 .. 1 ) ; 
T_open  : Open_type; 

Thread  : Read~type; 

T_word  : Word  type; 
begin 


output  the  package  specification 

For  each  read_open,  output  a procedure  spec  for  it  using  the 
Handle  as  the  name  of  the  procedure  along  with  an  extension 
include  appropriate  parameters  for  each  field  in  its 
attribute  list,  starting  with  'a'  - name  doesn't  matter 


Put_line_f <" — THis  is  A DUMMY  package  ADDED  BY  THE  PREPROCESSOR 
Put_l ine_f  { "package  " & Dummy_pack_name  & " is"); 

FOR  i in  1 . . Open_pack  . Size__of  (Open_list)  loop 
T^Qpen  : - Open^pack  . Get_item  ( i , Open_list ) ; 

T_word  :=  T open. Handle/ 

Put_line_f (w  procedure  n & T_word. Name ( 1 . . T word.Len)  & 

" dummy  ( " ) ; 

Param  name  : - "a";  “* 

T_wor3  :«  Word jack  . Get_item  ( 1 , T open. Ary) ; 

Put_f("  " & Param_name  & ^ : " & 

T_word . Name ( 1 . .T_word.Len) ) / 

FOR  k in  2 . . Word_pack . Size_of (T_open . Ary)  loop 

Param  name(l)  character ' succ (param  name(l)); 

Put_lTne_f ” 

T^word  Word_pack . Get_item ( k, T open. Ary); 

Put_f  (”  " & Paranwiame  & w : " & 

T_word . Name ( 1 . . T_word . Len ) ) ; 

end  loop; 

Put_line_f (");"); 
end  loop; 

Put_line_f  ( "end  " & Dummy_pack_name  & 

Output  the  Package  body 

For  each  read^open,  output  a Procedure  body  for  it  using  the 
Handle  as  the  name  of  the  procedure  along  with  an  extension 
include  appropriate  parameters  for  each  field  in  its 
attribute  list,  starting  with  'a'  - name  doesn't  matter 
only  Statement  in  body  should  be  null 

Put_line_f  ( "package  body  " & Dummyjsack  name  & n is"); 

FOR  i in  1 . . Openj>ack . Size_of  {Open  list!"  loop 
T_open  :*  Open^pack  . Get_item  (i , Open_list ) ; 

T_word  :*  T open. Handle; 

Fut_line_f (w  procedure  " & T_word. Name ( 1 .. T_word . Len)  & 

" dummy  { " ) ; 

Param^name  :«  "a"; 

T_word  Word_jpack . Get_item ( 1 , T open. Ary); 

Put_f  ("  " & Param_name  & ir  : " & 

T^word  .Name  { 1 ..  T__word  . Len)  ) ; 

FOR  k in  2 . . Word  pack . Size_of { T_open . Ary ) loop 

Param  name(l)  :«  character' succ (param  name ( 1 ) ) ; 

Put_llne_f (";");  ■“ 

T_word  Word^pack  . Get_item  ( k,  T open. Ary); 

Put_f("  " & Param_name  & w : " & 

T_word . Name ( 1 . . T_word . Len) ) ; 

end  loop; 

Put__line_f  ( " ) is  "); 

Put_line_f ("  begin")  ; 

Put_line_f ("  null;") ; 

Put_line_f  <"  end;")  ; 
end  loop; 

Put_line_f  ( "end  " & Dummy_pack_name  & 

Put_line_f;  " 

end; 


Outputs  a call  to  the  appropriate  dummy  procedure  from  the  read  opens 
uses  Handle  with  extension  as  the  procedure  name  and  includes 
actual  paramters  for  each  of  the  fields  in  the  address  list 


procedure  Write_call (Handle  : in  Word_type; addr : in  Word_type)  is 
T_read  : Read_type;  " 

T_word  : Word_type; 

Index  : Integer; 


begin 

Put_line__f ; 

( " This  is  a call 

Put_line_f ("package ")  ; 

Put_!ine_f  (Dummy^pack_naune  & 


to  the  dummy  procedure  in  dummy 


& Handle. Name (1 .. handle 


Index  Srch  read_Ary_id (addr ) ; 

T read  :=  ReaHpack . Get_item ( Index, Read  list) 
t — ^ •-  Word_pack . Get  item ( 1, T read.AFy); 

n r fr» i . » — 1 


Len ) & 

"_dummy  ( 


T__word 

f ( ’ 


Put 
FOR' 

Put_iine 
T__w°rd  : 
Put_f  (" 
end  loop; 
Put_line_f ( 
end; 


_ ^ T word . Name ( 1 *. T word.Len) ) ; 

i in  2 . . Word^paclt . Size_of  (T_rea3.  Ary)  loop 
_f  ( / ) / 

- Word_pack . Get_item (i, T_read .Ary) ; 

& T_word. Name < 1. ,T_word. Len) ) ; 

") /")  ; 


Scan  the  input  for  attribute  read  and  read  open 
1 1— °f  the  attribute  and  address'arrays 


procedure  Pass_one  (Open  list 

Read  list 


Word  : Word_type  :■ 

T_°Pen  : Open_t^pe; 

T_read  : Read  type; 

State:  Integer  range  0..4 


in  out  Open_pack.List_type; 
in  out  Read pack. List  type)  is 


( (others  ->  ' ' ) , 0)  ; 


0; 


) ) ) ) then 


then 


' '>,0); 

’ ATTRIBUTE  READ") 


then 


begin 
loop 

Word  : - Get_next_word; 
exit  when  Word. Len  - 0; 
if  (Word . Name ( 1 ) /-  ' ' ) and 

(Word.Name(l)  /-  Ascii. ht)  and 
( Word . Name ( 1 ) /-  Ascii. If)  and 
(not  ((Word. len  > 2)  and  then 

((Word. Name (i)  - and  (Word. Name (2)  - 

case  State  is 
when  0 -> 

if  ( Word . Name ( 1 .. Word . Len ) - "READ  OPEN") 

State  1;  - ’ 

T_open . Ary  id  : - ((others  => 

T open . Han3le  ((others  -> 
elsif  (Word. Name (1 . .Word. Len)  = 

State  3; 

T read. Ary  id  :=  ((others  =>  ' 
end  if; 
when  1 -> 

if  (Word. Name ( 1)  /-  ',')  then 

T_open . Ary_id.Name ( 1 . . Word. Len) 

T_open . Ary_id . Len  :=  Word. Len; 
else 

State  2; 

end  if; 
when  2 => 

if  ( Word . Name ( 1 ) /=*  then 

T_open . Handle . Name ( 1 . . Word . Len) 

T__open  . Handle  . Len  : = Word.  Len; 
else 

if  Srch_open_Handle (Word)  - 0 then 
^Pen_Pack • Add  item(T  open, Open  list)  • 
else  “ “ - 

endUir-ine("Err°r:  Handle  used  in  two  read_opens 1 


) ,0)  ; 


Word. Named.  .Word. Len) 


:=  Word. Name (1 .. Word. Len) 


0; 


State  : =* 
end  if; 
when  3 *> 

if  (Word .Name ( 1 ) * then 

State  4; 

end  if; 
when  4 ~> 

if  (Word. Name ( 1)  /—  then 

Thread. Ary_id . Name ( 1 . .Word.Len)  :»  Word .Name ( 1 . .Word.Len) 
Thread. Ary_id.Len  :*  Word.Len; 
else 

if  Srch__read_Ary_id  (Word)  - 0 then 

Read_jpack . Add_item  (T_read,  Read_list ) ; 
end  if; 

State  0; 

end  if; 
end  case; 
end  if; 
end  loop; 
end  Pass  one; 


Scan  the  input  for  the  delcarations  of  attribute  and  address  arrays 
Store  the  fields  in  corresponding  list 


procedure  Pass_two  (Open_list  ; in  out  Open_pack . List_type; 

~ Read_list  : in  out  Read_pack . List_type)  is 

Word  : Word__type  ((others  «>  ' '),0); 

T_word  : Word  type  : ■ ((others  *>  ' ')/0); 

Att r_type_wor3  : Word_type  : ■ ((others  ->  ' '),0); 

T_open  : Open^type; 

Thread  : Read__type; 

Index  : Integer; 

State:  Integer  range  0..9  j—  0; 

begin 

Reset_input ; 

State  0; 
loop 

Word  :»  Get_next_word; 
exit  when  Word.Len  * 0; 
if  (Word .Name ( 1 ) /-  ' ')  and 

(Word .Name ( 1 ) /-  Ascii. ht)  and 

( Word . Name ( 1 ) /-  Ascii. If)  and 

(not  ((Word.len  > 2)  and  then 

( (Word. Name ( 1 ) - ' - ' ) and  (Word. Name (2)  - '-'))))  then 
case  State  is 
when  0 ~> 

if  (Srch_open_Ary_id ( Word)  > 0)  then 
State  1; 

Index  Srch_open  Ary_id (Word) ; 

T open  Open^paclc  . get_item  ( Index,  Open_list)  ; 
elsi?  (Srch_read_Ary_id  ( Word)  > 0)  then 
State  :•  6; 

Index  : * Srch_read_Ary_id ( Word) ; 

T read  :■  Read_pack . get^item ( Index , Read_list) ; 
end  Tf; 
when  1 =*> 

if  (Word. Name  ( 1 ) =■  ' : f ) then 

State  :»  2; 

elsif  (Word. Name ( 1 ) = then 

State  0; 
end  if; 
when  2 *> 

if  ( Word . Name ( 1 ) - ' (')  then 
State  : =»  3; 


end  if; 
when  3 =*> 

if  (Word. Name (1)  = '(')  then 
State  : =-  4; 

T word . Len  :=  0; 
end  Tf; 
when  4 => 

if  (Word. Name (1)  - ' , ' ) then 
T_word.Name (T_word. Len+1)  := 

T_word.Len  T_word.len  + 1; 
elsif  (Word. Name (1 ) /-  ')')  then 

T_wo rd. Name (T_word. Lent l..T_word. Len tWord. Len 


T word. Len 


else 

declare 


T word. Len 


Word . Name ( 1 . 
+ Word. Len; 


) 

. Word. Len)  ; 


Attr_type  : constant  String  := 
begin  M0DB-Packa^ .Get_type (T_word. name ( 1 . . T_word . len) ) 

^ttr_ type  i word,  name  (1 . . Attr  type'  lencrth)  amt  ♦- 
tr— tyP*_ word- len  Attr_type' length;  ' Attr-lS'Pe' 

Word_pack. Add  item (Attr  type  word, T open  Arv)  • 

end  if; 
when  5 »> 


if  (Word .Name ( 1 ) - ',')  then 
State  3; 

elsif  (Word. Name (1)  - ')')  then 
State  0; 

end  if; 
when  6 -> 

if  (Word. Name (1)  - then 

State  :«  7; 

elsif  (Word. Name (1)  - then 

State  0; 

end  if; 
when  7 -> 

if  (Word. Name  ( 1)  * '(')  then 
State  : = 8 ; 

T_word.Len  0; 
end  if; 
when  8 «> 


if  (Word . Name ( 1 ) 
T_word . Name (T 

T_word.Len 

else 


/"  ' ' ' ) then 

word. Len+1 . . T_word.Len+Word. Len) : - 


T_word . Len  + Word. Len; 


oiiic 


. nux:a . Len ) 


Word^pack . Add_item (T^word, T read. Arv) ; 

StatiP?-k9yPdate-item<T-read,Read-1^3^ Index> ; 

end  if; 
when  9 =■> 

if  (Word. Name ( 1 ) - then 

T_word. Len  0; 

State  8; 

elsif  (Word. Name ( 1 ) - 
State  0; 

end  if; 


end  case; 
end  if; 
end  loop; 
nd  Pass  two; 


' ) ' ) then 


Echo  the  input  to  the  output  along  with  the  dummy  package  and 
dummy  procedure  calls 


procedure  Pass_three  (Open_list  : in  out  Open__pack  . List_type ; 

Read_list  : in  out  Readjpack . List~type ) is 

Word  : Word_type  : =*  ((others  ->  ' '),0);  ~ 

T_Handle  : Word_type  :*  ((others  ->  ' ' ) / 0 ) / 

T_addr  : Word_type  ( (others  *>  ' ' ) , 0)  ; 

State:  Integer  range  0..5  0; 

begin 

Reset_input ; 
loop 

Word  : * Get_next_word; 
exit  when  Word.Len  - 0; 
case  State  is 
when  0 »> 

if  (Word.Name(l . .Word.Len)  - "BEGIN” ) then 
Write_package; 

State  1; 

end  if; 
when  1 -> 

if  (Word. Name ( 1 . .Word.Len)  - "ATTRIBUTE_READ")  then 
State  2; 

end  if; 
when  2 — > 

if  (Word. Name (1)  /-  then 

T_Handle . Name ( 1 .. Word . Len)  Word. Name  ( 1 . .Word.  Len)  ; 

T_Handle.Len  Word.Len; 
else 

State  3; 

end  if; 
when  3 

if  (Word. Name (1)  /«  then 

T^addr  .Name  ( 1 ..  Word.  Len)  :»  Word. Name ( 1 .. Word. Len) ; 
T_addr.Len  Word.Len; 
else 

State  :*  4; 
end  if; 
when  4 =»> 

if  (Word. Name (1)  - then 

State  5; 
end  if; 
when  5 *> 

Write__call (T_handle, T_addr)  ; 

State  1; 
end  case; 

if  (word. name (1)  - ascii. If)  then 
Put_line_f  ; 
else 

Put_f  (Word. Name  ( 1 . . Word.  Len)  ) ; 
end  if; 
end  loop; 

Put_line_f;  — forces  a new_line  at  end  of  output  file 
end  Pass  three; 


Main  program 

It  works  in  three  main  passes : 

1.  Scans  the  input  and  find  each  occurrance  of  ' open_read'  and 
' read_openf  . ~~ 

For  each  9 open_read' , adds  an  'open'  item  to  the  open_list 

and  stores  the  handle  and  name  of  the  attribute  array  in  that 


item. 

F°r  attr^ute_read'  <•  adds  a 'read'  item  to  the  read  list 

and  stores  the  name  of  the  address  array  in  that  item.- 

2'  SCa2nHt=HHlnpUt  ^ find  Where  each  of  the  attribute  arrays 
and  address  arrays  are  declared.  y 

For  each  attribute  array  found,  update  that  item  in  the  open  list 

th»  ^.ration,  add  a„  entry  i^tSe 
compSneS?  OP"’  lte"  that  the  type  of  that 

For  each  address  array  found,  update  that  item  in  the  read  list- 
For, each  component  in  the  declaration,  add  an  entry  in  the 
ary  part  of  the  read  item  that  contains  the  name  of  the 
component  without  the  address  qualifier. 

3.  Just  before  the  begin  of  the  main  procedure,  output  a dummy 
package  that  contains  a procedure  for  each  of  the  handles 
in  the  open  list.  The  parameters  to  each  array  will  have 
dummy  names  but  will  be  of  the  types  obtained  in  the 
attribute  array. 

For  each  of  ' attribute_read' : immediately  after,  place  a call  to 
the  appropriate  dummy  procedure.  The  parameters  will  be  the 
components  found  m the  address  array,  except  without  the 
address  qualifier. 


begin 

--  Open  input  and  Output  files 
declare 

inn_fname  : string ( 1 . .Max_name  len)  ; 
inn__size  : integer;  ™ 

out_fname  : string ( 1 . .Max  name  len); 
°ut_3ize  : integer; 
begin 


loop 

put  ("Enter  input  file  name  ->  "); 

9et_line  (inn__fname,  inn^size)  ; 

put ( Enter  output  file  name  (not  same  as  input)  ->  " 

line  (out  fname,  out  size)  ; 

exit  when  ( (Tnn^size  /-  out_size)  or  else 

(inn  fname (1 . . inn_size)  /*  out  fname(l 
Pyt_line(  Input  an3  Output  must  be  different  files") 
end  loop;  ' 


- out  size ) ) 


^ inn_fname  ( 1 . . inn_size)  , out_fname  (1 . . out  size)  ) 

Pass_one  (Open_list , Read_list ) ; 

Pass_two(Open_li3tf  Read“list)  ; 

Pass_three (Open_list,  Read  list); 
else  ~ 

Put_l ine ( "Error  opening  files"); 
end  if; 
end; 


end  Preprocess; 


Appendix  B 


I PC  Message  Queue  Performance 
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Job:  read. me 

Date:  Sat  Mar  28  21:21:56  1992 


COMMlTOT?A^nMyhS^°reS  311  the  fileS  t0  simulate  the  IPC  MESSAGE  QUEUE 
COMMUNICATION  between  processes.  Two  processes  are  created  with  nnp 

program  using  the  fork  system  call.  One  is  the  sender  (parent)  and  the 
other  is  the  receiver  (child) . The  sender  sends  a short  message ?reg£est 
to  the  receiver  through  one  IPC  Message  Queue.  The  receiver  receives 
td?  ^e<?uest  and  sends  a response  back  to  the  sender  through  another 
IPC  Message  Queue.  The  sender  receives  the  response  message  This 
terminates  one  IPC  communication.  TESTING  IS  DONE  FOR  THE  NUMBER  of  qrMI 
AND  RECEIVING  CYCLES  FROM  1000  to  5000  in  steps  of  1000  Th^ound-trio 

measured  results  are  m file  rodbcompl.out  for  the  receiver  and  ?n 
rodbcomp2 . out  for  the  sender.  receiver  and  m file 
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Job:  rodb_test_data . ada 

Date:  Sat  Mar  28  21:30:25  1992 


FLAG  : in 

pragma  INTERFACE (C,  MSGGET) ; 
pragma  INTERFACE_NAME( MSGGET, 
function  MSGSND (MSQID  : in 

MSGP  : in 
MSGSZ  : in 
MSGFLG  : in 
pragma  INTERFACE (C,  MSGSND); 
pragma  INTERFACE_NAME( MSGSND, 
function  MSGRCV (MSQID  : in 

MSGP  : in 
MSGSZ  : in 
MSGTYP  : in 
MSGFLG  : in 
pragma  INTERFACE (C,  MSGRCV); 
pragma  INTERFACE_NAME (MSGRCV, 
function  MSGCTL (MSQID  : in 

CMD  : in 
BUFF  : in 
pragma  INTERFACE (C,  MSGCTL); 
pragma  INTERFACE_NAME (MSGCTL, 
end  RODB_Test_Data ; 


return  integer; 

"msgget") ; 
integer; 

S YSTEM. address ; 
integer; 

integer)  return  integer; 

"msgsnd") ; 
integer; 

SYSTEM. address; 

integer; 

integer; 

integer)  return  integer; 

"msgrcv") ; 
integer ; 
integer; 

SYSTEM. address)  return  integer; 
"msgctl") ; 


with  TEXT_IO,  SYSTEM; 
use  TEXT_IO,  SYSTEM; 
package  RODB_Test_Data  is 

— Message  queue  system  call  interface 
function  MSGGET (KEY  : in  integer; 

integer) 
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Job:  rodb_test6 . ada 

Date:  Sat  Mar  28  21:48:39  1992 


rt  ft  rt  rt  rt  rt  ft 


— This  is  the  performace  test  for  ipc  message  queue 

with  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Test_Data , POS IX  UNSAFE  PROCESS  PF 
use  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Test_Data , POSIX  UNSAFE  PROCESS  PF 
with  POSIX_PROCESS_IDENTIFICATION,  POSIX_PROCESS_PRIMITIVES ; ~ 
use  POSIX_PROCESS_IDENTIFICATION,  POSIX_PROCESS  PRIMITIVES* 
procedure  RODB_Test6  is 

— Constant  definition 

MSGKEY1  : constant  integer  :=  99; 

MSGKEY2  : constant  integer  :=  100; 

MTEXT_SIZE  : constant  integer  :=  500; 

MSG_LEN  : constant  integer  :=  10; 

— Data  type  definition 

type  MSGForm_Type  is  record 

MType  : integer; 

MText  : string ( 1 .. MTEXT_SIZE) ; 
end  record; 


— Package  instantiation 

package  INT_IO  is  new  TEXT_IO. INTEGER_IO( integer ) ; 
package  FIX_IO  is  new  TEXT_I0. FIXED_IO (duration) ; 


— Variable  definition 


My_PiD 

My_Status 

Msgidl 

Msgid2 

Flag 

Number_Of_Times 

Start_Time 

Finish_Time 

Outf ile 

Sender_Msg 

Receiver_Msg 

My_Msg 

Your_Msg 

My_Response 

Your_Response 


POSIX_PROCESS_IDENTIFICATION . process 

POSIX_PROCESS_PRIMITIVES . termination 

integer; 

integer; 

integer; 

integer; 

CALENDAR . t ime ; 

CALENDAR. time ; 
f ile_type; 

MSGForm_Type ; 

MSGForm_Type ; 
string ( 1 . . MSG_LEN ) ; 
string (1. .MSGLEN) ; 
string ( 1 . .MSGLEN) ; 
string ( 1 . . MSGLEN) ; 


id; 

status; 


— Exception  definition 
Msg_Exception  : exception; 
begin 


— Input  the  number  of  times  from  user 
put ("Enter  the  number  of  times:  " ); 
INT_IO.get(Number_Of_Times) ; 

— “ Create  two  IPC  Message  Queues (request  and  response  queues) 
Msgidl  :=  RODB_Test_Data . MSGGET (MSGKEY1 , 1023); 
if  Msgidl  = -l  then 

put_line(" Error  in  MSGGET."); 
raise  Msg_Exception; 
end  if; 

Msgid2  :=  RODB_Test_Data . MSGGET (MSGKEY2 , 1023); 
if  Msgid2  = -l  then 

put_line( "Error  in  MSGGET."); 
raise  Msg_Exception; 
end  if; 


— Create  two  processes  (Sender  and  Receiver) 

My_PID  :=  POSIX_UNSAFE_PROCESS_PRIMITIVES. fork;  — fork  a receiver  child 
if  My_PID  = POSIX_PROCESS_IDENTIFICATION.NULL_PROCESS_ID  then  — Child 
Start_Time  :=  CALENDAR. clock;  _ 

for  I in  1 . . Number_Of_Times  loop 

Flag :=RODB_Test_Data. MSGRCV (Msgidl,  Receiver  Msg'address,  MSG  LEN  1 o 
if  Flag  = -1  then  “ ~ 

put_line ("Error  in  MSGRCV."); 
raise  Msg_Exception; 
end  if; 

My_Msg ( 1 . . MSG_LEN)  :=  Rece iver_Msg. MText ( 1. .MSGLEN) ; 

My_Response ( 1 . . MSG_LEN)  :=  "Hello  guys"; 

Sender_Msg . MType  : = 1; 

Sender_Msg.MText ( 1 . .MSG_LEN)  : = My_Response ( 1 . . MSG_LEN ) ; 

Flag  :=  RODB_Test_Data . MSGSND (Msgid2 , Sender_Msg' address,  MSGLEN,  0) ; 
if  Flag  = -1  then  - 

put_line( "Error  in  MSGSND."); 
raise  Msg_Exception; 
end  if; 
end  loop; 

Finish_Tixne  :=  CALENDAR. clock; 

Delay  20.0;  — Wait  for  parent  to  manipulate  the  message  queue 

— Output  the  result  to  a file 

create (Outfile,  outfile,  "rodbcompl.out", 

form=>"world=>read,  owner=>read_write") ; 
put_line (Outfile,  "Number_Of_Iterations  Times"); 

INT_IO . put ( Out f i le , Number_Of_Times ) ; 

FIX_IO. put (Outfile,  Finish_Time-Start_Time) ; 
new_line (Outfile) ; 
close (Outfile) ; 

POSIX_PROCESS_PRIMITIVES . exit_process ; — Child  Exits 

else  — Parent 

Start_Time  :=  CALENDAR. clock; 
for  I in  1 . . Number_Of_Times  loop 

Your_Msg ( 1 . . MSG_LEN)  :=  "Hi  world!"; 

Sender_Msg. MType  :=  1; 

Sender_Msg . MText ( 1 . . MSG_LEN ) : = YourMsg ( 1 . . MSG_LEN ) ; 

Flag  :=  RODB_Test_Data. MSGSND (Msg idl,  SenderMsg' address , MSG_LEN , 0) ; 
if  Flag  = -1  then 

put_l ine ( " Error  in  MSGSND . " ) ; 
raise  Msg_Exception; 
end  if; 

Flag:=RODB_Test_Data.MSGRCV(Msgid2 , Receiver_Msg' address , MSGLEN,  1,0) 
if  Flag  « -1  then 

put_l ine ("Error  in  MSGRCV."); 
raise  Msg_Exception; 
end  if; 

Your_Response ( 1 . .MSG_LEN)  :=  Rece iver_Msg. MText ( 1 .. MSG_LEN) ; 
end  loop; 

Finish_Time  :=  CALENDAR. clock; 
end  if; 

POSIX_PROCESS_PRIMITIVES . wait_for_child (My_Status) ; 

— Output  the  result  to  a file 

create (Outf ile , out_file,  "rodbcomp2 . out" , 

f orm=>"world=>read , owner=>read_write" ) ; 


Put_line(Outf ile,  "Number_Of_Iterations  Times"); 

INT_IO . put (Out file , Number_Of_Times); 

FIX_IO. put (Out file,  Finish_Time-Start  Time); 
new_line (Outf ile) ; - 

close(Outf ile) ; 

Remove  the  IPC  Message  Queues (request  and  response  queues) 
Flag  :=  RODB_Test_Data.MSGCTL(Msgidl,  0,  SYSTEM. NULL  ADDRESS  ; 
if  Flag  = -1  then  - ' ' 

put_line( "Error  in  MSGCTL . " ) ; 
raise  Msg_Exception; 
end  if; 

Flag  :=  RODB_Tes t_Da ta . MSGCTL ( Msg id2 , 0,  SYSTEM. NULL  ADDRESS) • 
if  Flag  = -1  then 

put_line( "Error  in  MSGCTL."); 
raise  Msg_Exception; 
end  if; 


exception 

when  Msg_Exception  => 

put_line(" Program  terminates  abnormally."); 
when  others  => 

put_line ( "Other  exception  in  main  proqram."); 
end  RODB_Test6 ; 
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Job : rodbcomp 1 . out 

Date:  Sat  Mar  28  21:31:31  1992 


Number_Of_Iterations  Times 
1000  1.29565 

Number_Of_Iterations  Times 
2000  2.51501 

Number_Of_Iterations  Times 
3000  3.75342 

Number_Of_Iterations  Times 
4000  5.08582 

Number_Of_Iterations  Times 
5000  6.33374 
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Job : r odbcomp2 .out 

Date:  Sat  Mar  28  21:31:44  1992 


Nuraber_Of_lterations  Times 

1000  1.29565 

Number_Of_lterations  Times 

2000  2.52454 

Number_Of_Iterations  Times 

3000  3.75342 

Number_Of_Iterations  Times 

4000  5.08582 

Number_Of_Iterations  Times 

5000  6.33374 


Appendix  C-l 


Uncontested  RODB  Reads 
and 

Uncontested  RODB  Writes 

All  Protection  Mechanisms  are  Enabled  as  Semaphore  Protection  and 
Disabling  of  Preemption  to  Guarantee  Atomic  Semaphore  Transitions  in 
Place. 
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J ob : read . me 

Date:  Mon  Mar  30  00:56:21  1992 


This  directory  stores  all  the  files  to  build  up  a RODB  "attribute"  components. 
The  protection  mechanism  is  that  locking  is  set  at  the  RODB  level.  During  the 
lock  setting,  there  is  a prevention  of  preemption  used  to  protect  the 
semaphore  test-and-lock  operation  to  insure  atomicity.  This  is  done  inside  a 
C function  by  using  the  fast_setprio  system  call.  There  is  only  one  set  of 
three  UNIX  semaphores  in  the  whole  system  but  a total  of  seven  array  operation 
on  these  three  semaphores.  Before  actual  READING,  a set  of  five  semaphore 
operations  are  imposed  upon  the  three  semaphores,  two  of  which  are  repeated. 
The  reason  for  the  five  (with  two  repeats)  is  to  simulate  what  might  have 
to  be  done  if  this  were  to  be  implemented  with  the  current  Lynx  OS 
(where  the  kernel  is  preemptable)  and  no  prevention  of  preemption  were  to  be 
done;  ( This  is  done  in  a later  test) . After  actually  reading  the  RODB  one 
semaphore  operation  is  imposed  on  the  semaphores.  Before  actual  WRITING 
there  are  two  levels  of  operations:  write  desire  and  write  lock.  For 
write  "desire”  only  one  semaphore  operation  is  imposed  on  the  semaphores  and  f 
write  "lock"  an  array  of  four  semaphore  operations  are  imposed  on  the 
smaphores.  After  actual  writing,  a set  of  two  semaphore  operations  are  imposed 
on  the  semaphores.  A TEST  IS  DONE  TO  MEASURE  HOW  LONG  IT  TAKES  FOR  1000  TO  100 
READS  AND  WRITES.  THE  RESULTS  ARE  IN  FILE  rodbcompl.dat  for  reads.  THE  RESULTS 
ARE  IN  FILE  rodbcomp2.dat  for  writes.  This  test  does  not  involve  contention 
since  the  reads  and  writes  are  done  in  separate  runs. 
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Job:  rodbtstSI . ada 

Date:  Mon  Mar  30  00:48:25  1992 


— This  is  the  reading  test  program,  (uncontested  reads) 

with  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
use  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
procedure  RodbtstSl  is 

— Constant  definitions 

ATTR_SIZE  : constant  integer  :=  200; 

RESULT_S I Z E : constant  integer  :=  10; 

— Data  type  definition 
type  Result_Type  is  record 

Loops  : integer; 

Times  : duration; 
end  record; 


— Package  instantiation 

package  INT_IO  is  new  TEXT_IO. INTEGERIO (integer) ; 
package  FIXIO  is  new  TEXTIO. FIXEDIO (duration) ; 
package  RCDT  renames  RODB_Component_Data_Types; 
package  RODBCP  renames  RODB_Component ; 


— Variable  definitions 


Length 

Number  Of_Times 

Addr_List 

Attr_List 

Start_Time 

Finish_Time 

Results 

Outf ile 


integer; 
integer ; 

RCDT • Pos_List_Type ( 1 . .ATTRSIZE) ; 

RCDT . Attr_Li st_Type ( 1 . .ATTRSIZE) ; 
CALENDAR . time ; 

CALENDAR. time ; 

array (1. . RESULT_SIZE)  of  Result_Type; 
f ile_type; 


begin 

RODBCP.  Load_Corops  ( "rodbcomp.  dat" ) ; — load  the  test  RODB 
Length  :=  1; 

Addr_Li s t ( 1 ) : = 0 ; 

Number_Of_Times  :=  1000;  — inner  loop  iterations  initialization 
for  I in  1. .RESULT_SIZE  loop 

Start_Time  :=  CALENDAR. clock;  — get  the  start  time  for  inner  loop 
for  J in  1. . Number _0f_Times  loop 

RODBCP. Read_Attrs (Addr_List,  Length,  Attr_List) ; — Read  RODB 
end  loop ; 

Finish_Time  :=  CALENDAR. clock;  — record  the  end  time 

Results(I)  :=  (Number_Of_Times,  Finish_Time-Start_Time) ; --  Store  data 
Number_Of_Times  :=  Number_Of_Times  + 1000; 
end  loop ; 


— Output  the  result  to  a file  now  that  test  is  over 
create (Outf ile,  out_file,  " rodbcomp 1 . out” , 

f orm=>"world=>read,  owner=>read_write" ) ; 
put_line( Out file,  " rodbcompl.dat  ")  ; 

put_line (Outf ile,  "Test  NO  NO_Of_Iterations  Times"); 
for  I in  1. .RESULT_SIZE  loop 

INT_IO. put (Outf ile,  I,  width  =>  5)  ; 

INT_I0.put (Outf ile,  Results(I) .Loops)  ; 

FIX_I0.put (Outf ile,  Results (I) .Times)  ; 
new_line (Outf ile) ; 
end  loop; 
close(0utf ile) ; 
exception 

when  others  => 


PRECEDING  PAGE  BLANK  NOT  FiLMED 


put_line ( "Main  program  exception”) 


end  Rodbtst81; 
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Job:  rodbcompl . out 

Date:  Mon  Mar  30  00:57:09  1992 


Test  NO  NO  Of  Iterations  Times 


1 

1000 

1.43  866 

2 

2000 

2 . 90466 

3 

3000 

4 .33374 

4 

4000 

5.80927 

5 

5000 

7.24799 

6 

6000 

8.71387 

7 

7000 

10. 14307 

8 

8000 

11.62805 

9 

9000 

13.04773 

10 

10000 

14.53265 
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Job:  rodbtst82 . ada 

Date:  Mon  Mar  30  00:48:26  1992 


— This  is  the  writing  test  program,  uncontested  writes 

with  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
use  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
procedure  Rodbtst82  is 

— Constant  definitions 

ATTR_SIZE  : constant  integer  :=  200; 

RESULT_SIZE  : constant  integer  :=  10; 

— Data  type  definition 
type  Result_Type  is  record 

Loops  : integer; 

Times  : duration; 
end  record; 


— Package  instantiation 

package  INT_IO  is  new  TEXT_I0. INTEGER_IO( integer) ; 
package  FIX_IO  is  new  TEXT_IO. FIXED_I0 (duration)  ; 
package  RCDT  renames  RODB_Component_Data_Types; 
package  RODBCP  renames  RODB_Component ; 


— Variable  definition 


Length 

Nurober_Of_Times 

Addr_List 

Attr_List 

Start_Time 

Finish_Time 

Results 

Outf ile 


integer; 

integer; 

RCDT. Pos_List_Type ( 1 . . ATTRSIZE) ; 
RCDT. Attr_List_Type ( 1 . . ATTR_SIZE) ; 
CALENDAR . time ; 

CALENDAR . t ime ; 

array ( 1. . RESULT_SIZE)  of  ResultType; 
file  type; 


begin 

RODBCP . Load_Comps ( "rodbcomp . dat" ) ; — load  the  RODB  Components 
Length  : = 1 ; 

Addr_List(l)  :=  0; 

Attr_List(l)  :=  (Type_ID  =>  0,  Int_Value  =>  200); 
Number_0f_Times  :=  1000; 
for  I in  1. .RESULT_SIZE  loop 

Start_Time  :=  CALENDAR. clock;  — log  the  beginning 
for  J in  1 . . Number_Of_Times  loop 

RODBCP. Write_Attrs (Addr_List , Length,  Attr_List) ; — write 
end  loop ; 

Finish_Time  :=  CALENDAR. clock;  — log  the  end 
Results(I)  :=  (Number_Of_Times,  Finish_Time-Start_Time) ; 
Number_Of_Times  :=  Number_Of_Times  + 1000; 
end  loop; 


— Output  the  result  to  a file  now  that  test  is  over 
create (Outf ile,  out_file,  "rodbcomp2 . out" , 

form=>"world=>read,  owner=>read_wr ite" ) ; 
put_line (Outf ile,  " rodbcomp2 . out  "); 

put_line (Outf ile,  "Test  NO  N0_0f_Iterations  Times") ; 
for  I in  1. .RESULT_SIZE  loop 

INT_I0 . put (Outf ile , I,  width  =>  5)  ; 

INT_I0.put (Outf ile,  Results(I) .Loops)  ; 

FIX_I0 . put (Outf ile , Results(I) .Times) ; 
new_line (Outf ile) ; 
end  loop; 
close(0utf ile) ; 
exception 


when  others  => 

put_line ( "Main  program  exception") ; 


end  Rodbtst82; 
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Job:  rodb  component  . 

ada 

Date:  Mon  Mar 

30  00:48 

: 28 

1992 

with  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
use  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
package  Rodb_Component  is 

— Package  renaming 

package  RCDT  renames  Rodb_Component_Data_Types ; 

— Exception  definition 
Shm_Exception  : exception; 

Shm_Outrange  : exception; 

Sem_Exception  : exception; 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  out  RCDT. Attr_List_Type)  ; 

— Write  attributes  to  RODB  components 

procedure  Write_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  RCDT.Attr_List_Type) 

— Print  out  the  semaphore  values 

procedure  Print_Sems; 

— Load  RODB  components  from  a disk  file 

procedure  Load_Comps (Filename  : in  string); 

— Save  RODB  components  to  a disk  file 

procedure  Save_Comps (Filename  : in  string); 

— Shutdown  the  RODB  components 
procedure  Shutdown_Comps ; 


end  RODB_COMPONENT ; 
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Job:  rodbcomp2 . out 

Date:  Mon  Mar  30  00:48:24  1992 


rodbcomp2 . out 

Test  NO  NO  Of  Iterations  Times 


1 

1000 

1.73431 

2 

2000 

3.57086 

3 

3000 

5.30518 

4 

4000 

7.09534 

5 

5000 

8.88556 

6 

6000 

10.66620 

7 

7000 

12.40057 

8 

8000 

14.22754 

9 

9000 

15.92505 

10 

10000 

17.76160 
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— This  package  provides  the  constants,  instantiated  packages,  system  calls 

— and  C functions  interfaces  to  C language  for  RODB  COMPONENT  package, 
with  TEXT_IO,  SYSTEM; 

use  TEXT_IO,  SYSTEM; 

package  RO DB_COMPON ENT_D AT A_T Y P E S is 


— Constants 


INT  SIZE 

constant 

integer 

: = 

10; 

CHAR  SIZE 

constant 

integer 

: = 

10; 

BOOL  SIZE 

constant 

integer 

: = 

10; 

FLT  SIZE 

constant 

integer 

: = 

10; 

SHMKEY 

constant 

integer 

: = 

99; 

SEMKEY 

constant 

integer 

: = 

100; 

SHM  SIZE 

constant 

integer 

: = 

INT  SIZE*4+CHAR  SIZE+BOOL  SIZE+4*FLT  SIZE 

CHAR  OFFSET 

constant 

integer 

: = 

INT  SIZE*4 ; 

BOOL  OFFSET 

constant 

integer 

: = 

CHAR  OFFSET  + CHAR  SIZE*1; 

FLT  OFFSET 

constant 

integer 

• — 

BOOL_OFFSET  + BOOL_SIZE*l; 

— Data  types 

type  Attr_Type (Type_ID 

: integer  : 

= 0)  is  record 

case  Type_ID  is 
when  0 => 


Int_Value  : integer; 
when  1 => 

Char_Value  : character; 
when  2 => 

Bool_Value  : boolean; 
when  3 => 

Flt_Value  : float; 
when  others  => 
null; 
end  case; 
end  record; 

type  Attr_List_Type  is  array ( integer  range  <>)  of  Attr_Type; 
type  Pos_List_Type  is  array ( integer  range  <>)  of  integer; 

— Package  instantiation 

package  INT_IO  is  new  TEXT_IO. INTEGER_IO( integer) ; 
package  BOOL_IO  is  new  TEXT_IO. ENUMERATION_IO (boolean) ; 
package  FLT_IO  is  new  TEXT_IO. FLOAT_IO ( float) ; 
function  FINT  is  new  system. fetch_from_address (integer) ; 
function  FCHAR  is  new  system. fetch_frora_address (character) ; 
function  FBOOL  is  new  system. fetch_from_address (boolean) ; 
function  FFLT  is  new  system. fetch_from_address (float) ; 
procedure  AINT  is  new  system. assign_to_address ( integer) ; 
procedure  ACHAR  is  new  system. assign_to_address (character) ; 
procedure  ABOOL  is  new  system. assign_to_address (boolean) ; 
procedure  AFLT  is  new  system. ass ign_to_address (float) ; 

— Shared  memory  system  call  interface 
function  SHMGET(KEY  : in  integer; 

SIZE  : in  integer; 

FLAG  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SHMGET) ; 
pragma  INTERFACE_NAME ( SHMGET,  "shmget"); 
function  SHMAT(SHMID  : in  integer; 

SHMADDR  : in  system. address; 

FLAG  : in  integer)  return  system. address ; 
pragma  INTERFACE (C,  SHMAT); 
pragma  INTERFACE_NAME (SHMAT,  "shmat"); 


function  SHMDT ( SHMADDR  : in  system. address)  return  integer; 

pragma  INTERFACE (C,  SHMDT); 

pragma  INTERFACE_NAME( SHMDT,  "shmdt"); 

function  SHMCTL ( SHMID  : in  integer; 

CMD  : in  integer; 

BUFF  : in  system. address)  return  integer; 

pragma  INTERFACE ( C , SHMCTL); 
pragma  INTERFACE_NAME (SHMCTL,  "shmctl"); 

— Semaphore  system  call  and  C function  interface 
function  SEMGET(KEY  : in  integer; 

NSEMS  : in  integer; 

FLAG  : in  integer)  return  integer; 

pragma  INTERFACE ( C , SEMGET); 
pragma  INTERFACE_NAME( SEMGET,  "semget"); 
function  SEMSINIT(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMSINIT); 
pragma  INTERFACE_NAME( SEMSINIT,  "semsinit"); 
function  SEMPRINT ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMPRINT); 
pragma  INTERFACE_NAME( SEMPRINT,  "semprint"); 
function  READBEG (SEMID  : in.  integer)  return  integer; 
pragma  INTERFACE (C,  READBEG); 
pragma  INTERFACE_NAME( READBEG,  "readbeg") ; 
function  READEND( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READ END ) ; 
pragma  INTERFACE_NAME ( READ END , " readend" ) ; 
function  WRITEBEG( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEBEG) ; 
pragma  INTERFACE_NAME (WRITEBEG,  "writebeg") ; 
function  WRITEEND (SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEEND); 

. pragma  INTERFACENAME (WRITEEND,  "writeend"); 

function  SEMSRMV( SEMID  : in  integer)  return  integer; 

pragma  INTERFACE (C,  SEMSRMV) ; 

pragma  INTERFACE_NAME (SEMSRMV,  "semsrmv" ) ; 

end  RODB_Component_Data_Types; 
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with  TEXT_IO,  SYSTEM,  Rodb  Component_Data_Types ; 
use  TEXT_IO,  SYSTEM,  Rodb~Component_Data_Types ; 
package  Rodb_Component  is 

— Package  renaming 

package  RCDT  renames  Rodb_Component_Data_Types; 

— Exception  definition 
Shm_Exception  : exception; 

Shm_Out range  : exception; 

Sem_Exception  : exception; 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  out  RCDT. Attr_List_Type) ; 

— Write  attributes  to  RODB  components 

procedure  Write_Attrs (Addr_List  : in  RCDT. Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  RCDT. Attr_List_Type) 

— Print  out  the  semaphore  values 

procedure  Print_Sems; 

— Load  RODB  components  from  a disk  file 

procedure  Load_Comps (Filename  : in  string); 

— Save  RODB  components  to  a disk  file 

procedure  Save_Comps (Filename  : in  string); 

— Shutdown  the  RODB  components 
procedure  Shutdown_Comps ; 


end  RODB_COMPONENT ; 
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with  TEXT_IO , CALENDAR,  SYSTEM,  PREEMPTION_CONTROL , Rodb  Component  Data  T\ 
use  TEXT_IO , CALENDAR,  SYSTEM,  PREEMPTION  CONTROL,  Rodb  Component_Da ta_T' 
package  body  Rodb_Component  is  “ ~ - J 

— Local  variables 
Shraid  : integer; 

Shmaddr  : system. address; 

Semid  : integer; 

— Local  subprograms 

procedure  Load_Ints( Infile  : in  FILETYPE) ; 

procedure  Load_Chars (Infile  : in  FILE_TYPE) ; 

procedure  Load_Bools (Inf ile  : in  FILE_TYPE) ; 

procedure  Load_Flts (Inf ile  : in  FILE~TYPE) ; 

procedure  Save_Ints (Outf ile  : in  FILE_TYPE) ; 

procedure  Save_Chars (Outf ile  : in  FILETYPE) ; 

procedure  Save_Bools (Outf ile  : in  FILEJTYPE) ; 

procedure  SaveFlts (Outf ile  : in  FILEJTYPE); 

— Read  attributes  from  RODB  components  simulating  array  of  handles  read 
procedure  Read_Attrs (Addr_List  : in  RCDT. Pos_List  Type; 

Length  : in  integer;  ~ 

Attr_List  : in  out  RCDT.Attr  List  Type)  is 
Temp  : system. address; 

Flag  : integer; 
begin 

PREEMPTION_CONTROL. DISABLE  PREEMPTION;  — more  efficient  in  C proqr. 
Flag  :=  RCDT. READBEG (Semid) ; 

--  PREEMPTION_CONTROL. ENABLE  PREEMPTION;  — in  C program 
if  Flag  = -l  then 

raise  Sem_Exception; 
end  if; 

for  I in  1.. Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr_List (I)  > RCDT. SHM  SIZE-1)  then 
raise  Shm_Outrange ; — 

end  if; 

Temp  :=  Shmaddr  + system. of f set (Addr_List (I)  ) ; 
if  (Addr^List(I)  < RCDT. CHAR_OFFSET)  then 

Attr_LTst(I)  :=  (Type_ID  =>  0,  Int_Value  =>  RCDT. FINT (Temp) ) ; 
elsif  (Addr_List (I)  < RCDT. BOOL_OFFSET)  then 

A^tr_List(I)  :=  (Type_ID  =>  1,  Char_Value  =>  RCDT. FCHAR (Temp) ) ; 
elsif  (Addr_List (I)  < RCDT. FLT_OFFSET)  then 

Attr_List(I)  (Type_ID  =>  2,  Bool_Value  =>  RCDT. FBOOL (Temp) ) ; 
else 

Attr_List(I)  :=  (Type_ID  =>  3,  FltValue  =>  RCDT. FFLT (Temp) ) ; 
end  if; 
end  loop; 

— PREEMPTION_CONTROL. DISABLE_PREEMPTION ; — again  done  in  C proqram 
Flag  :=  RCDT. READEND( Semid) ; — This  is  a C function 

— PREEMPTION_CONTROL . ENABLE_PREEMPTION ; 
if  Flag  = -l  then 

raise  Sem_Exception; 
end  if; 

end  Read_Attrs; 

Write  attributes  to  RODB  components  again  simulating  array  of  handies 
procedure  Write_Attrs (Addr_List  : in  RCDT. Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  RCDT.Attr  List  Type)  is 

Temp  : system. address ; 


Flag  : integer; 
begin 

— PREEMPTION_CONTROL.DISABLE_PREEMPTION;  /*  In  C program  for  efficiency  */ 
Flag  :=  RCDT. WRITEBEG (Semid) ; — also  a C function 

— PREEMPTION_CONTROL.ENABLE_PREEMPTION;  /*  Also  in  C */ 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1..  Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr_List (I)  > RCDT.SHM_SIZE-l)  then 
raise  Shm_Outrange; 
end  if; 

Temp  :=  Shmaddr  + system. offset (Addr_List (I) ) ; 
if  (Addr_List (I)  < RCDT . CHAR_OFFSET)  then 
RCDT . AINT (Temp , Attr_List (I) . Int_Value) ; 
elsif  (AddrList(I)  < RCDT . BOOL_OFFSET)  then 
RCDT . ACHAR (Temp , Attr_List (I) . Char_Value) ; 
elsif  (Addr_List (I)  < RCDT.FLTOFFSET)  then 
RCDT . ABOOL (Temp , Attr_List (I) . BoolValue) ; 
else 

RCDT . AFLT (Temp , Attr_List(I) .FltValue) ; 
end  if; 
end  loop; 

— PREEMPTION_CONTROL.DISABLE_PREEMPTION;  /*  In  C program  */ 

Flag  RCDT. WRITEEND( Semid ) ; — AC  function 

— PREEMPTION_CONTROL.ENABLE_PREEMPTION;  /*  In  C program  */ 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

end  Write_Attrs; 

— Print  out  the  semaphore  values 
procedure  Print_Sems  is 
Flag  : integer ; 
begin 

Flag  :=  RCDT. SEMPRINT( Semid ) ; 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

end  Print_Sems; 


— Load  RODB  Components  from  a disk  file. 

— The  structure  of  disk  file  is  as  following: 

Number_Of_Integers 
Positionl  Integerl 

— Position2  Integer2 

* • « • 

Number_Of_Characters 
Positionl  Characterl 

— Position2  Character2 

Number_Of_Boo leans 
Positionl  Booleanl 
Position2  Boolean2 


Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 


procedure  Load_Comps (Filename 


m 


string) 


is 


Infile  : FILE_TYPE; 

Temp  : system. address; 

Flag  : integer; 
begin 

open(Inf ile,  in_file,  Filename); 

— Initialize  RODB  Integer  Component 
for  I in  1. .RCDT. INT_SIZE  loop 

Temp  :=  Shmaddr  + system. of f set ( (I-l) *4)  ; 

RCDT. AI NT (Temp,  0) ; 
end  loop; 

Load_Ints (Inf ile) ; 

— Initialize  RODB  Character  Component 
for  I in  1. .RCDT.CHAR_SIZE  loop 

Temp  :=  Shmaddr  + system. offset (RCDT. CHAR  OFFSET  + i-i)  • 
RCDT. ACHAR( Temp,  'X');  ~ 

end  loop; 

Load_Chars(Infile) ; 

Initialize  RODB  Boolean  Component 
for  I in  1. .RCDT.BOOL_SIZE  loop 

Temp  :=  Shmaddr  + system. offset (RCDT. BOOL  OFFSET  + I-l)  • 
RCDT . ABOOL ( Temp , true ) ; ~ 

end  loop ; 

Load_Bools (Inf ile) ; 

Initialize  RODB  Float  Component 
for  I in  1 . . RCDT . FLT_SIZE  loop 

Temp  :=  Shmaddr  + system,  offset  (RCDT.  FLT  OFFSET  + ri-n*4i* 
RCDT. AFLT( Temp,  0.0);  ~ ' ' *' 

end  loop; 

Load_Flts ( Inf ile) ; 
close(Inf ile) ; 

Flag  :=  RCDT. SEMSINIT (Semid) ; 
if  Flag  = -l  then 

raise  Sem_Exception; 
end  if; 

exception 

when  name_error  => 

Put_line ( "File  cannot  be  opened."); 

Put_line( "Loading  components  fails!"); 
when  data_error  | end_error  => 

Pu^_line ("File  format  is  incompatible."); 
put_line ( "Loading  components  fails!"); 
when  Sem_Except ion  => 

put_line ("Semaphore  cannot  be  initialized. ") ; 
raise  Sem_Exception; 
when  others  => 

put_line ( "Unknown  exception.") ; 
put_line ( "Loading  components  fails!"); 
end  Load_Comps; 

— Save  RODB  Components  to  a disk  file 

— The  structure  of  the  disk  file  is  as  following: 

Number_Of_Integers 


— Positionl  Integerl 

— Position2  Integer2 

“ ” * • • 

— Number_Of_Characters 

— Positionl  Characterl 

— Position2  Character2 

“ “ • • « 

Number_Of_Boo leans 
Positionl  Booleanl 
Position2  Boolean2 
™ ™ • • « 

Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 

procedure  Save_Comps (Filename  : in  string)  is 
Outfile  : FILE_TYPE; 
begin 

if  Filename  /=  ""  then 

create (Outfile,  out_file.  Filename, 

form=>Mworld=>read,  owner=>read_write" ) ; 

Save_Ints (Outfile) ; 

Save_Chars (Outfile) ; 

Save_Bools (Outfile) ; 

Save_Flts (Outfile) ; 
close (Outfile) ; 
else 

Save_Ints (TEXT_IO. standard_output) ; 

Save_Chars ( TEXT_IO . standard_output ) ; 

Save_Bools (TEXT_IO. standard_output) ; 

Save_Flts (TEXT_IO. standard_output) ; 
end  if; 
exception 

when  constraint_error  => 

put_line("RODB  Components  data  collapsed. **) ; 
put_line( "Saving  components  fails!"); 
when  others  => 

put_line( "Unknown  exception."); 
put_line( "Saving  components  fails!"); 
end  Save_Comps; 

— Shutdown  RODB  Components 
procedure  Shutdown_Comps  is 

Flag  : integer; 
begin 

Flag  :=■  RCDT.  SHMDT  ( Shmaddr ) ; 
if  Flag  =*  -l  then 

raise  Shm_Exception; 
end  if; 

Flag  :=  RCDT . SHMCTL ( Shmid , 0,  system. null_address) ; 
if  Flag  = -1  then 

raise  Shm_Exception; 
end  if; 

Flag  :=  RCDT. SEMSRMV(Semid) ; 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

end  Shutdown_Comps ; 


pragma  page; 


— Load  all  the  integers  from  a disk  file  to  RODB  Integer  Component 
procedure  Load  Ints( Infile  : in  FILE_TYPE)  is 

Length  : integer ; 

Temp_Pos  : integer ; 

Temp_Int  : integer; 

Temp_Addr  : system. address ; 
begin 

INT_IO.get (Inf ile.  Length); 

skip_line( Infile) ; 

for  I in  1 . . Length  loop 

INT_IO.get (Inf ile,  Temp_Pos) ; 

INT_IO. get (Infile,  Temp_Int) ; 
skip_line(Inf ile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. INT_SIZE-1)  then 
raise  Shm_Outrange; 
end  if; 

Temp_Addr  :=  Shmaddr  + system. offset (Temp_Pos *4) ; 

RCDT . AINT ( Temp_Addr , Temp_Int ) ; 
end  loop; 
end  Load_Ints; 

— Load  all  the  charaters  from  a disk  file  to  RODB  Character  Component 
procedure  Load  Chars (Infile  : in  FILE_TYPE)  is 

Length  : Integer ; 

Temp_Pos  : integer ; 

Temp_Char  : character ; 

Temp_Addr  : system. address; 
begin 

INT_IO.get (Inf ile,  Length); 

skip_line ( Inf ile) ; 

for  I in  1.. Length  loop 

INT_IO.get (Inf ile,  Temp_Pos) ; 

get(Infile,  Temp_Char) ; — Skip  a space 

get(Infile,  Temp_Char) ; 
skip_line(Inf ile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. CHAR_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :=  Shmaddr  + system. of f set (RCDT. CHAR_OFFSET+Temp_Pos) ; 
RCDT . ACHAR ( Temp_Addr , Temp_Char) ; 
end  loop; 
end  Load_Chars; 

— Load  all  the  booleans  from  a disk  file  to  RODB  Boolean  Component 
procedure  Load  Bools (Infile  : in  FILE_TYPE)  is 

Length  : Integer ; 

Temp_Pos  : integer ; 

Temp_Bool  : boolean; 

Temp_Addr  : system. address ; 
begin 

INT_I0. get (Infile,  Length); 

skip_line ( Inf ile)  ; 

for  I in  1.. Length  loop 

INT_I0.get (Inf ile,  Temp_Pos); 

BOOL_IO. get (Infile,  Temp_Bool) ; 
skip_line ( Inf ile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. BOOL_SIZE-l)  then 
raise  Shm_Outrange ; 
end  if; 


Temp_Addr  :=  Shmaddr  + system.offset(RCDT.BOOL_OFFSET+Temp_Pos); 
RCDT . ABOOL ( Temp_Addr , Temp_Bool) ; 
end  loop ; 
end  Load_Bools; 

— Load  all  the  floats  from  a disk  file  to  RODB  Float  Component 
procedure  Load  Fits (Infile  : in  FILE_TYPE)  is 

Length  : integer ; 

Temp_Pos  : integer; 

Temp_Flt  : float; 

Temp_Addr  : system. address; 
begin 

INT_IO.get (Inf ile,  Length); 

skip_line (Infile) ; 

for  I in  1.. Length  loop 

INT_IO . get (Infile,  Temp_Pos ) ; 

FLT_IO. get (Infile,  Temp_Flt) ; 
skip_line(Inf ile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.FLT_SIZE-1)  then 
raise  Shm_Outrange; 
end  if; 

Temp_Addr  :=  Shmaddr  + system,  offset  (RCDT.  FLT_OFFSET+Temp  Pos*4); 
RCDT . AFLT ( Temp_Addr , Temp_Flt) ; 
end  loop ; 
end  Load_Flts; 

pragma  page; 

— Save  all  the  integers  from  RODB  Integer  Component  to  a disk  file 
procedure  Save_Ints( Out file  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Integers  is:  ") ; 

Int_IO. put (Out file,  RCDT. INT_SIZE)  ; 
new_line(Outf ile) ; 
for  I in  1. .RCDT.INT_SIZE  loop 
put(Outfile,  "Integer  number  ") ; 

Int_IO.put( Out file,  1-1,  width  =>  5) ; 
put (Outf ile,  ":"); 

Temp_Addr  :=  Shmaddr  + system. offset ( (1-1) *4) ; 

Int_IO. put (Outf ile,  RCDT. FINT(TempAddr) ) ; 
new_line (Out file) ; 
end  loop; 
end  Save_Ints; 

— Save  all  the  characters  from  RODB  Character  Component  to  a disk  file 
procedure  Save_Chars (Outf ile  : in  FILETYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Characters  is:  ") ; 

Int_IO. put (Outf ile,  RCDT. CHAR_SIZE) ; 

new_line (Outf ile) ; 

for  I in  1. .RCDT.CHAR_SIZE  loop 

put(Outfile,  "Character  number  "); 

Int_IO.put (Outf ile,  1-1,  width  =>  5)  ; 
put (Outf ile,  ":"); 

Temp_Addr  :=  Shmaddr  + system. offset (RCDT. CHAR_OFFSET  + 1-1); 
put (Outf ile,  RCDT . FCHAR ( Temp_Addr ) ) ; 
new_line (Outf ile) ; 
end  loop; 


end  Save_Chars; 


— Save  all  the  booleans  from  RODB  Boolean  Component  to  a disk  file 

procedure  Save_Bools (Outf ile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 

.begin 

put(Outfile,  "Number  Of  Booleans  is:  ") ; 

Int_IO. put (Outf ile,  RCDT. BOOL_SIZE) ; 
new_line (Outf ile) ; 
for  I in  1. .RCDT. BOOL_SIZE  loop 
put(Outfile,  "Boolean  number  ") ; 

Int_IO. put (Outf ile,  1-1,  width  =>  5); 
put(Outfile, 

Temp_Addr  :=  Shmaddr  + system. of f set (RCDT. BOOL  OFFSET  + 1-1) ; 
Bool_IO. put (Outf ile,  RCDT. FBOOL(Temp_Addr) ) ; 
new_line (Outf ile) ; 
end  loop; 
end  Save_Bools; 

— Save  all  the  floats  from  RODB  Float  Component  to  a disk  file 
procedure  Save_Flts (Outf ile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Floats  is  ") ; 

Int_IO . put ( Outf i le , RCDT. FLT_SIZE) ; 
new_line (Outf ile) ; 
for  I in  1 . . RCDT . FLT_SI ZE  loop 
put (Out file,  "Float  number  ") ; 

Int_IO.put (Outf ile,  1-1) ; 
put (Outf ile,  ":"); 

Temp_Addr  :=  Shmaddr  + system. offset (RCDT. FLT_OFFSET  + (I-l)*4); 
Flt_IO. put (Outf ile,  RCDT. FFLT(Temp_Addr) ) ; 
new_line (Outf ile) ; 
end  loop; 
end  Save_Flts; 

pragma  page; 

begin 

Shmid  :=  RCDT. SHMGET( RCDT. SHMKEY,  RCDT. SHMSIZE,  1023); 
if  Shmid  = -1  then 
raise  Shm_Exception; 
end  if; 

Shmaddr  :=  RCDT . SHMAT ( Shmid , system. null_address,  0); 

— if  Shmaddr  = system. null_address  then 

raise  Shm_Exception; 

— end  if; 

Semid  :=  RCDT. SEMGET( RCDT. SEMKEY,  3,  1023); 
if  Semid  = -1  then 
raise  Sem_Exception; 
end  if; 

end  Rodb_Component ; 
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Job:  readbeg.c 

Date:  Mon  Mar  30  01:00:08  1992 


/*  File: 
/include 
/include 
/include 
/include 
/include 


readbeg.c  This  is  read  begin  subroutine  to  set 
<sys/ types. h> 

<sys/ ipc . h> 

<sys/sem. h> 

<sys/sched.h> 

<st . h> 


reading  protect 


/*  The  operations  on  semaphores  */ 
struct  sembuf  RREAD_START 
struct  sembuf  RWAIT_NO_WRITE  LOCK 
struct  sembuf  RWAIT_NO_WRITE~DESIRE 

int  readbeg ( semid) 
int  semid; 

{ 

®^^uct  sembuf  one of  n readersfSl  * 

int  flag; 

void  perror ( ) ; 
t id_t  my_t id ; 
int  my_prio; 


{ °/  1/  0}; 

{ 1>  0,  0>; 

{ 2/  0,  0 } ; 


/*  Three  semaphore  operations  */ 


/*  Raise  the  priority  to  prevent  the 
my_tid  = getstid() } 

“7— Pri°  = getprio(getpid() ) ; 
fast_setprio(my_tid,  31); 


preemption 


*/ 


/*  Perform  three  semaphore 
one_of_n_readers [ 0 ] 
one_o  f _n_r eade  r s ( l ] 
one_of_n_readers [ 2 ] 
one_of_n_readers [ 3 ] 
one_of_n_readers ( 4 ) 
flag  = semop( semid, 
if. (flag  ==  -i)  { 

perror ("readbeg  fails:  ") 


operations,  two  of 
= RWAIT_NO_WRITE_LOCK; 

= RWAIT_NO_WRITE_DES IRE ; 

= RWAIT_NO_WRITE_LOCK; 

= RWAIT_NO_WRITE  DESIRE; 

= RREAD_START;  ~ 
one_of_n_readers,  5)  ; 


} 


them  twice  (see  read. me) 
/*  Wait  for  no  more  writ 
/*  Wait  for  no  more  writ 
/*  Wait  for  no  more  writ 
/*  Wait  for  no  more  writ 
/*  Prevent  writers  in  */ 
/*  Lock  the  critical  sect 


/*  Lower  the  priority  to  normal  */ 
^as^_se^Pri°(®y_tid,  my_prio) ; 

return  flag; 


} 
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Job:  readend.c 

Date:  Mon  Mar  30  01:00:18  1992 


/*  File: 
/include 
/include 
/include 
/include 
/include 


readend. c This  is  read  end  subroutine  to  reset  protection 
<sys / types. h> 

<sys/ ipc . h> 

<sys/sem.h> 

<sys/sched.h> 

<st . h> 


*/ 


/*  The  operations  on  the  semaphore  * / 
struct  sembuf  RREAD END  { ^ 1 


int  readend (semid) 
int  semid; 

{ 

int  flag; 
void  perror(); 
tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  = getstid(); 
my_prio  = getprio(getpid() ) ; 
fast  setprio(my_tid,  31) ; 


/*  Perform  the  semaphore  operation  */ 
flag  = semop( semid,  &RREAD_END,  1) ; 
if  (flag  ==  -1)  { 

perror ( "readend  fails:  ")  ; 

} 


/*  Unlock  critical  section  */ 


/*  Lower  the  priority  to  the  normal  */ 
fast  setprio(my_tid,  my_prio) ; 


return  flag; 


} 
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Job:  writebeg.c 

Date:  Mon  Mar  30  01:00:32  1992 


/*  File:  writebeg.c  This  is  write  begin  subroutine  to  set  protection  */ 
/include  <sys/types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 
struct  sembuf  WWAIT_NO_READERS  = { o, 

struct  sembuf  WREAD_START  = { 0, 

struct  sembuf  WWRITE_LOCK  = { 1, 

struct  sembuf  WWRITE_DESIRE  = { 2, 

struct  sembuf  WIN_PROGRESS_WRITE  = { 2, 

int  writebeg(semid) 
int  semid; 

{ 

struct  sembuf  sole_writer [4 ] ; /*  Four  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid_t  my_tid; 

int  my_pr io ; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  = getstid() ; 
my_prio  = getprio(getpid() ) ; 
fast_setprio(my_tid,  31) ; 

/*  Make  write  request  by  doing  a semaphore  operation  */ 
flag  = semop(semid,  &WWRITE  DESIRE,  1) ; 
if  (flag  ==  -l)  { 

perror ("Write-Request  in  writebeg  fails:  ")  ; 
return  flag; 

} 

/*  Perform  four  semaphore  operations  */ 

s°le_writer ( 0 ] = WWAIT_NO_READERS ; /*  Wait  for  no  more  readers  */ 

so  1® — wr it:err f 1 ] = WWRITE_LOCK;  /*  preventing  succeeding  reader 

s°le_writer (2 ] = WREAD_START;  /*  preventing  succeeding  writer 

s°le_writer ( 3 ] = WIN_PROGRESS_WRITE;  /*  Cancel  the  write-request  */ 

flag  = semop( semid,  sole_writer,  4);  /*  Lock  the  critical  section  */ 

if  (flag  = -1)  { 

perror ( "Write_Start  in  writebeg  fails:  " ) ; 


/*  Lower  the  priority  to  the  normal  */ 
fast_setprio (my_tid,  my_prio) ; 

return  flag; 


0,  0}; 
1,  0>; 
1,  0}; 
1,  0}; 
-1,  0}; 


} 
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Job:  writeend.c 

Date:  Mon  Mar  30  01:00:58  1992 


Qj  CL  O'  0> 


/*  File,  writeend.c  This  is  write  end  subroutine  to  reset  write  protect 
/include  <sys/types . h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 
struct  sembuf  WREAD_END  = { o,  -1,  0}; 

struct  sembuf  WWRITE_UNLOCK  = { 1,  -l’  o}; 

int  writeend(semid) 
int  semid; 

{ 

struct  sembuf  sole_writer[2] ; /*  Two  semaphore  operations  */ 

int  flag;  ' 

void  perror ( ) ; 

tid_t  my_tid; 

int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  =getstid(); 
my_prio  = getprio(getpid() ) ; 
fast_setprio(my_tid,  31); 

/*  Perform  the  semaphore  operation  */ 
sole_writer [0]  = WREAD_END; 
sole_writer [ 1]  = WWRITE_UNLOCK ; 
flag  = semop( semid,  sole  writer,  2) ; 
if  (flag  ==  -1)  { 

perror ("writeend  fails:  ") ; 


/*  Lower  the  priority  to  the  normal  */ 
f ast_setprio (my_tid,  my_prio) ; 

return  flag; 

} 


/*  Allow  writer  in  */ 

/*  Allow  reader  in  */ 

/*  Unlock  critical  section  */ 


t 

t 


r rrr 

oooo 

oooo 

ttttt 

rr  r 

o 

o 

o 

o 

t 

r 

o 

o 

o 

o 

t 

r 

o 

o 

o 

o 

t 

r 

o 

o 

o 

o 

t t 

r 

oooo 

oooo 

tt 

t 

t 


ssss 

eeee 

m 

m mm 

ssss 

ii 

n 

nnn 

ii 

ttttt 

s s 

e e 

mm 

m 

m 

s s 

i 

nn 

n 

i 

t 

ss 

eeeeee 

m 

m 

m 

ss 

i 

n 

n 

i 

t 

ss 

e 

m 

m 

m 

ss 

i 

n 

n 

i 

t 

s s 

e e 

m 

m 

m 

s s 

i 

n 

n 

i 

t t 

ssss 

eeee 

m 

m 

m 

ssss 

iii 

n 

n 

iii 

tt 

Job:  semsinit.c 

Date:  Mon  Mar  30  01:01:24  1992 


/*File:  semsinit.c  This  is  semaphore  init  subroutine  to  initialize  semap 
/include  <sys/ types . h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semsinit (semid) 
int  semid; 

{ 

short  initarray ( 3 ] ; 
int  flag; 
void  perror(); 

initarray [0]  = initarrayfl]  = initarray [2]  = 0; 
flag  = semctl (semid,  3,  SETALL,  initarray); 
if  (flag  ==  -1)  { 

perror ( "semsinit  fails:  ") ; 

> 

return (flag) ; 
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Job:  semsrrav.c 

Date:  Mon  Mar  30  01:01:37  1992 


/*  File:  semsrav.c  This  is  semaphore  remove  subroutine  to  remove  semaoho 
/include  <sys/ types . h>  F u 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semsrmv(semid) 
int  semid; 

{ 

int  flag; 
void  perror(); 

flag  = semctl (semid,  3,  IPC  RMID,  0) ; 
if  (flag  ==  -1)  { 

perror ("semsrmv  fails:  "); 

} 

return (flag) ; 
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Job:  semprint.c 

Date:  Mon  Mar  30  01:01:48  1992 


IS 


semaphore  print  subroutine  to  print  semapho 


/*File: semprint . c This 
/include  <sys/types . h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semprint (semid) 
int  semid; 

{ 

short  outarray [ 3 ] ; 
int  flag; 
void  perror(); 
int  i ; 

flag  = semctl (semid,  3,  GETALL,  outarray); 
if  (flag  ==  -1)  { 

perror ("semprint  fails:  ") ; 

> 

for  ( i=0;  i<3 ; ++i)  { 

printf ("Semaphore  %d  has  the  value  of  %d\n" 

> 

return (flag) ; 


i , outarray [ i ] ) ; 


> 


Appendix  C-2 

Uncontested  RODB  Reads 
and 

Uncontested  RODB  Writes 


Semaphore  Protection  in  Place  but  no  Disabling  of  Preemption  (i.e.  no 
raising/lowering  of  priorities) 
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Job:  read. me 

Date:  Wed  Apr  1 19:12:17  1992 


Appendix  C-3 


Uncontested  RODB  Reads 
and 

Uncontested  RODB  Writes 


Two  Disabling  and  Re-enabling  Pairs  for  each  Read  or  Write.  No  Protec- 
tion for  Actual  Reads  or  Writes. 
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Job:  read. me 

Date:  Sun  Apr  5 20:20:45  1992 


This  directory  stores  all  the  files  to  build  up  RODB  "attribute"  comDon,=n 
The  protection  mechanism  is  absent  for  this  test.  There  is  no  mechanism  n 
to  assure  mutual  exclusion.  Both  the  prevention-of-preemption  by  raisina 
process  priority  and  the  semaphore  operations  were  disabled.  WHAT  we 
TRYING  TO  MEASURE  IS  THE  TIME  REQUIRED  FOR  JUST  THE  "RAW"  READS  OR  troTTr 
THE  TEST  LOOPS  TO  MEASURE  HOW  LONG  IT  TAKES  FOR  1000  “ 10o“  RMDS^R  “ 
WRITES.  THE  RESULTS  FOR  READING  ARE  IN  FILE  rodbcompl . out  and  thi 
FOR  WRITING  ARE  IN  FILE  rodbcomp2 . out . The  reads  and  write!  are  RESULTS 
non-competing. 


Appendix  C-4 


Uncontested  RODB  Reads 
and 

Uncontested  RODB  Writes 


Protected  by  Disabling  Preemption  before  each  Read  or  Write  and  Re- 
enabling After. 


Appendix  C-5 


Uncontested  RODB  Reads 
and 

Uncontested  RODB  Writes 


No  disabling  of  preemption 
No  Semaphore  Protection 
Just  "raw"  RODB  Reads  and  Writes 
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Job:  read. me 

Date:  Thu  Apr  9 13:24:03  1992 


This  directory  stores  all  the  files  to  build  up  RODB  "attribute"  component 
The  protection  mechanism  is  that  locking  is  set  at  the  RODB  level  To  achi 
lock  setting,  a prevention-of-preemption  system  call  is  used.  This  is  donP 
inside  a C function  which  has  been  called  from  Ada.  The  mechanism  used  is 
e fast_setpno  system  call  which  is  supposed  to  change  priority  exDediti 
WE  ARE  TRYING  TO  SEE  HOW  MUCH  OVERHEAD  THERE  IS  FOR  THE  PRIORITY  CHANGE  ^ 
CALL.  A TEST  IS  DONE  TO  MEASURE  HOW  LONG  IT  TAKES  FOR  1000  TO  10000  RFAn^ 
WRITES  (two  priority  raise/lower  per  Read  or  Write  event).  THE  RESULT 
FILE  rodbcompl . out  for  reading.  THE  RESULT  IS  IN  FILE  rodbcomp2 . out  for  wr 


Appendix  D-l 


Concurrent  (Competing) 
Reader  and  Writer  Preformance  Test 


Full  Protection  of  Semaphores  and  RODB  Component. 
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Job:  read. me 

Date:  Sat  Apr  11  23:09:58  1992 


THIS  IS  A TEST  OF  CONCURRENT  (COMPETING)  READERS  AND  WRITERS. 

THERE  ARE  THREE  TASKS  RUNNING  IN  THIS  SYSTEM:  TWO  READERS  AND  ONE  WRITER. 

THEY  ARE  ACCESSING  THE  RODB  COMPONENT  WHICH  IS  PROTECTED  BY  A MECHANISM. 

IN  RODBTSTD1 , ALL  THE  TASKS  HAVE  THE  SAME  PRIORITIES.  THE  RESULTS  ARE  IN 
FILES  RODBCOMP1 . OUT  ( RODBCOMP 1 1 . OUT  AND  RODBCOMP12 . OUT) . THESE  RESULTS 
CORRESPOND  TO  THE  INPUT  FILES  RODBCOMP1 . IN  (RODBCOMP 11 . IN  AND  RODBCOMP 12 .IN) 

This  directory  stores  all  the  files  to  build  up  RODB  "attribute"  components. 

The  protection  mechanism  is  that  locking  is  set  at  the  RODB  level.  During  the 
lock  setting,  there  is  prevention  of  preemption.  This  is  done  inside  the 
C function  by  using  the  fast_setprio  system  call.  There  is  only  one  set  of 
three  UNIX  semaphores  in  the  whole  system.  Before  actual  reading,  a set  of  five 
semaphore  operations  are  imposed  on  the  semaphores.  After  a read  completes  one 
semaphore  operation  is  imposed  on  a semaphore.  Before  actually  writing, 
there  are  two  levels  of  semaphore  operations:  write-desire  and  write-lock. 

For  write-desire  one  semaphore  operation  is  imposed  (test&set)  on  a semaphore. 
Once  the  read-lock  semaphore  is  unlocked,  (i.e.  last  reader  exits),  then  a 
writer  can  enter  and  lock  out  all  new  readers  and  any  other  following  writer. 
Write-lock  imposes  a set  of  four  semaphore  operations  on  the  semaphores. 

After  actual  writing,  a set  of  two  semaphore  operations  are  imposed  on  the 
semaphores  (i.e.  unlock  for  readers  or  another  writer).  This  system  gives 
preferences  to  writers  but  readers  actually  reading  lock  out  any  writers 
that  are  waiting. 
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J ob : rodbtstDl . ada 

Date:  Sat  Apr  11  22:20:04  1992 


— This  is  the  concurrent  reading  and  writing  test  program  with  default  priorit 
with  TEXT_IO , CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
use  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Component  Data  Types,  RODB_Component ; 
with  RODB_Test_Datal;  ~ ~ 

procedure  RodbtstDl  is 

— Constant  definitions 

ATTR_SIZE  : constant  integer 

NUMBER_0F_TIMES1  : constant  integer 
NUMBER_0F_TIMES2  : constant  integer 
NUMBER_0F_TIMES3  : constant  integer 

— Package  instantiation 

package  INT_IO  is  new  TEXT_IO. INTEGER_IO( integer ) ; 
package  FIX_IO  is  new  TEXT_IO. FIXED_IO( duration) ; 
package  RCDT  renames  RODB_Component_Data_Types; 
package  RODBCP  renames  RODB_Component ; 

— task  declaration 
task  Readerl  is 

entry  Finish; 
end  Readerl; 
task  Reader2  is 
entry  Finish; 
end  Reader2 ; 
task  Writer  is 

entry  Finish; 
end  Writer; 


: = 200; 

: = RODB_Test_Datal . Number_Of_Timesl ; 
: = RODB_Test_Datal . Number_Of~Times2 ; 
: = RODB_Test_Datal . Number_0f_Times3  ; 


— Variable 

Start_Timel 

Start_Time2 

Start_Time3 

Finish_Timel 

Finish_Time2 

Finish_Time3 

Resultl 

Result2 

Result3 

Addr_Listl 

Addr_List2 

Addr_List3 

Attr_Listl 

Attr_List2 

Attr_List3 

Length 1 

Length2 

Length 3 

Outf ile 


definition 
CALENDAR. 
CALENDAR. 
CALENDAR. 
CALENDAR. 
CALENDAR. 
CALENDAR, 
duration; 
duration; 
duration; 
RCDT . Pos_ 
RCDT. Pos_ 
RCDT. Pos_ 
RCDT . Attr 
RCDT. Attr 
RCDT. Attr 
integer  : 
integer  : 
integer  : 
f ile_type 


time ; 
time; 
time; 
time; 
time; 
time; 


List_Type ( 1 . 
List_Type ( 1 . 
List_Type ( 1 . 
List_Type ( 1 
List_Type ( 1 
_List_Type ( 1 
= i; 

= l; 

= 1; 


ATTR_SIZE) 

ATTR_SIZE) 

ATTR_SIZE) 

. ATTR_SIZE) 
. ATTR_SIZE) 
.ATTR  SIZE) 


(0,  others=>0) ; 

(0,  others=>0) ; 

(0,  others=>0) ; 

((0,200) ,others=>(0, 200)  ) 
((0,200)  , others=>(0, 200)  ) 
((0,200) , others=> (0, 200) ) 


--  The  body  of  task  readerl 
task  body  Readerl  is 
begin 

Start_Timel  :=  CALENDAR. clock ; 
for  I in  1. . NUMBER_0F_TIMES1  loop 

RODBCP. Read_Attrs (Addr_Listl , Lengthl,  Attr_Listl) ; 
end  loop; 

Finish_Timel  :=  CALENDAR. clock; 

Resultl  :=  Finish_Timel  - StartTimel; 


accept  Finish; 
exception 

when  others  => 

put_line("Task  Readerl  has  an  exception."); 
end  Readerl; 

— The  body  of  task  reader2 
task  body  Reader2  is 
begin 

Start_Time2  :=  CALENDAR. clock; 
for  I in  1 . . NUMBER_0F_TIMES2  loop 

R0DBCP.Read_Attrs(Addr_List2,  Length2,  Attr_List2) ; 
end  loop; 

Finish_Time2  :=  CALENDAR. clock; 

Result2  :=  Finish_Time2  - Start_Time2 ; 

accept  Finish; 
exception 

when  others  => 

put_line("Task  Reader2  has  an  exception."); 
end  Reader2 ; 

— The  body  of  task  writer 
task  body  Writer  is 
begin 

Start_Time3  : = CALENDAR . clock ; 
for  I in  1. . NUMBER_0F_TIMES3  loop 

RODBCP . Write_Attrs (Addr_List3 , Length3,  Attr_List3) ; 
end  loop; 

Finish_Time3  :=  CALENDAR. clock ; 

Result3  :=  Finish_Time3  - Start_Time3 ; 

accept  Finish; 
exception 

when  others  => 

put_line ( "Task  Writer  has  an  exception."); 
end  Writer; 

begin 

— Terminate  gracefully 
Readerl. Finish; 

Reader2 . Finish ; 

Writer. Finish; 

— Write  out  the  results 

create(Outf ile,  out_file,  "rodbcompl . out" , 

form=>"world=>read,  owner=>read_write" ) ; 
put_line (Outf ile,  "Task  Number_Of_Iterations  Times"); 

put (Out file,  "Readerl  "); 

INT_IO. put (Out file,  NUMBER_OF_TIMES 1 ) ; 

FIX_IO. put (Outf ile,  Resultl) ; 

new_line (Outf ile) ; 

put (Outf ile,  "Reader2  ") ; 

INT_IO. put (Outf ile,  NUMBER_0F_TIMES2 ) ; 

FIX_IO.put (Outf ile,  Result2) ; 
new_line (Outf ile)  ; 
put(Outfile,  "Writer  "); 

INT_IO.put (Outf ile,  NUMBER_0F_TIMES3 ) ; 

FIX_IO. put (Outf ile,  Result3) ; 


new_line (Outf ile) 
close (Outfile) ; 


end  RodbtstDl; 
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Job:  rodbcomp.dat 
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10 

0  100 
1 200 

2 300 

3 400 

4 500  * 

5 600 

6 700 

7 800 

8 900 

9 1000 

10 

0 A 

1 B 

2 C 

3 D 

4 E 

5 F 

6 G 

7 H 

8 I 

9 J 

10 

0 false 

1 false 

2 false 

3 false 

4 false 

5 false 

6 false 

7 false 

8 false 

9 false 

10 

0 ^100.0 
1 200.0 

2 300.0 

3 400.0 

4 500.0 

5 600.0 

6 700.0 

7 800.0 

8 900.0 

9 1000.0 
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Date:  Sat  Apr  11  22:28:55  1992 


This  package  provides  the  constants,  instantiated  nackaaes 

withnTEXT_IO?tSYSTEM?terfaCeS  t0  ° la"gUage  for  R°DB  COMPONENT  package?3 

use  TEXT_IO,  SYSTEM; 

package  RODB_COMPONENT  DATA  TYPES  is 


— Constants 

INT_SIZE 

CHAR_SIZE 

BOOL_SIZE 

FLT_SIZE 

SHMKEY 

SEMKEY 

SHM_SIZE 

CHAR_OFFSET 

BOOL_OFFSET 

FLT  OFFSET 


constant 

constant 

constant 

constant 

constant 

constant 

constant 

constant 

constant 

constant 


integer 

integer 

integer 

integer 

integer 

integer 

integer 

integer 

integer 

integer 


10; 

10; 

10; 

10; 

99; 

100; 

INT_SIZE*4+CHAR_SIZE+BOOL  SIZE+4*FLT 
INT_SIZE*4 ; ~ 

CHAROFFSET  + CHAR_SIZE*1; 
BOOL_OFFSET  + BOOL  SIZE*1; 


: integer; 

: character; 
: boolean; 

: float; 


— Data  types 

type  Attr_Type(Type_ID  : integer  :=  0)  is  record 
case  Type_ID  is 
when  0 => 

Int_Value  : integer; 
when  1 => 

Char_Value  : character; 
when  2 => 

Bool_Value  : boolean; 
when  3 => 

Flt_Value  : float; 
when  others  => 
null; 
end  case; 
end  record; 

^irF^ifVType.is  array  ( integer  range  <>)  of  Attr  Type* 
type  Pos_List_Type  is  array  (integer  range  <>)  of  integer^  ' 

— Package  instantiation 

package  INTIO  is  new  TEXT_IO. INTEGER  10 ( integer)  • 
package  BOOL_IO  is  new  T EXT_ 10 . ENUMERATION  IO(boolean)  • 
package  FLT_IO  is  new  TEXT_IO . FLOAT  10 ( float) ; ' 

function  FINT  is  new  system. fetch_frora  address ( integer ) • 
function  FCHAR  is  new  system. fetch_froS  address (character) • 
function  FBOOL  is  new  system. fetch_from  address (boolean)  • ' 
function  FFLT  is  new  system. fetch_from  address ( float) • ' 

procedure  AINT  is  new  system. assign  to  address (integer)  • 
procedure  ACHAR  is  new  system. ass igK_t3  address (chJ?Jct4r)  • 

o?ocodnre  1S  neW  systen,*assign_to_address (boolean)  ; ' 

procedure  AFLT  is  new  system. assigntoaddress (float) ; * 

--  Shared  memory  system  call  interface 
function  SHMGET (KEY  : in  integer; 

SIZE  : in  integer; 

FLAG  : in  integer)  return  inteaer- 

pragma  INTERFACE (C,  SHMGET);  integer, 

pragma  INTERFACE_NAME ( SHMGET,  "shmget") • 
function  SHMAT ( SHMID  : in  integer; 

SHMADDR  : in  system . address ; 

FLAG  : in  integer)  return  system  addre=?«5* 
pragma  INTERFACED,  SHMAT);  system,  address , 

pragma  INTERFACE_NAME (SHMAT,  "shmat") ; 


function  SHMDT ( SHMADDR  : in  system. address) 
pragma  INTERFACE (C,  SHMDT) ; 
pragma  INTERFACE_NAME (SHMDT,  "shmdt") ; 
function  SHMCTL ( SHMID  : in  integer; 

CMD  : in  integer; 

BUFF  : in  system. address) 
pragma  INTERFACE (C,  SHMCTL) ; 
pragma  INTERFACE_NAME( SHMCTL,  "shmctl"); 


return  integer; 


return  integer; 


— Semaphore  system  call  and  C function  interface 
function  SEMGET(KEY  : in  integer; 

NSEMS  : in  integer; 

FLAG  : in  integer)  return  integer; 

pragma  INTERFACE (C,  SEMGET); 
pragma  INTERFACE_NAME( SEMGET,  "semget"); 
function  SEMSINIT(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE ( C , SEMSINIT) ; 
pragma  INTERFACE_NAME (SEMSINIT,  "semsinit"); 
function  SEMPRINT(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMPRINT) ; 
pragma  INTERFACE_NAME ( SEMPRINT,  "semprint") ; 
function  READBEG(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READBEG) ; 
pragma  INTERFACE_NAME( READBEG,  "readbeg") ; 
function  READ END ( SEMID  : in  integer)  return  integer* 
pragma  INTERFACE (C,  READEND) ; ' 

pragma  INTERFACE_NAME ( READEND , M r eadend " ) ; 
function  WRITEBEG (SEMID  : in  integer)  return  integer* 
pragma  INTERFACE (C,  WRITEBEG); 
pragma  INTERFACE_NAME (WRITEBEG,  "writebeg") ; 
function  WRITEEND (SEMID  : in  integer)  return  integer* 
pragma  INTERFACE (C,  WRITEEND);  ' 

pragma  INTERFACE_NAME ( WRITEEND,  "writeend") ; 
function  SEMSRMV(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE ( C , SEMSRMV) ; 
pragma  INTERFACE NAME (SEMSRMV,  "semsrmv" ) ; 

end  RODB_Component_Data  Types; 
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with  TEXT_IO,  SYSTEM,  Rodb_Component_Data  Types; 

use  TEXT XO,  SYSTEM,  Rod  b Component  Data  Types; 

package  Rodb_Component  is  — ~ 

— Package  renaming 

package  RCDT  renames  Rodb_Component_Data_Types; 

— Exception  definition 
Shm_Exception  : exception; 

Shm_Outrange  : exception; 

Sem_Exception  : exception; 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT. Pos_List  Type; 

Length  : in  integer;-  — 

Attr_List  : in  out  RCDT. Attr_List_Type) ; 

— Write  attributes  to  RODB  components 

procedure  Write_Attrs (Addr_List  : in  RCDT.Pos_List  Type; 

Length  : in  integer;  — 
AttrJList  : in  RCDT. Attr_List_Type) 

— Print  out  the  semaphore  values 
procedure  Print_Sems; 

— Load  RODB  components  from  a disk  file 

procedure  Load Comps (Filename  : in  string); 

— Save  RODB  components  to  a disk  file 
procedure  Save_Comps (Filename  : in  string); 

— Shutdown  the  RODB  components 
procedure  Shutdown_Comps ; 


end  RODB_COMPONENT ; 


t 

t 

r rrr  oooo  oooo  ttttt 

rr  r o o o o t 

r oooo  t 

r oooo  t 

r oooo  t t 

r oooo  oooo  tt 


r rrr 

rr  r 

r 

r 

r 

r 


d 

b 

d 

b 

d 

b 

oooo 

ddd  d 

b bbb 

o o 

d dd 

bb  b 

o o 

d d 

b ; 

o o 

d d 

b ] 

o o 

d dd 

bb  b 

oooo 

ddd  d 

b bbb 

cccc 
c c 

c 
c 

c c 

cccc 


oooo 
o o 

o o 

o o 

o o 

oooo 


m 

m nun 

mm 

m 

m 

m 

ra 

m 

m 

m 

m 

m 

m 

m 

m 

m 

m 

J ob : rodb_component . ada 
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'O'OTJTi'n'n'n'n 


with  TEXT_IO,  CALENDAR,  SYSTEM, 
use  TEXT_IO,  CALENDAR,  SYSTEM, 
package  body  Rodb_Component  is 


PREEMPT ION_CONTROL,  Rodb_Component  Data  Types- 
PREEMPTION_CONTROL,  Rodb_Component_Data~Types  j 


— Local  variables 
Shmid  : integer; 

Shmaddr  : system. address; 
Semid  : integer; 


— Local  subprograms 
procedure  Load_Ints ( Inf ile  : in 
procedure  Load_Chars (Inf ile  : in 
procedure  Load_Bools (Inf ile  : in 
procedure  Load_Flts (Inf ile  : in 
procedure  Save_Ints (Outf ile  : in 
procedure  Save_Chars (Outf ile  : in 
procedure  Save_Bools (Outf ile  : in 
procedure  Save_Flts (Outf ile  : in 


FILETYPE) ; 
FILE_TYPE) ; 
FILE_TYPE) ; 
FILETYPE) ; 
FILETYPE) ; 
FILE_TYPE) ; 
FILETYPE) ; 
FILETYPE) ; 


— Read  attributes  from  RODB  components 
procedure  Read_Attrs (Addr_List 

Length 
Attr_List 

Temp  : system. address; 

Flag  : integer; 
begin 


in  RCDT.Pos_List_Type; 

in  integer;  ~ 

in  out  RCDT . Attr_List_Type ) is 


— PREEMPTION_CONTROL. DISABLE  PREEMPTION; 
Flag  :=  RCDT. READBEG (Semid) ; “ 

” PREEMPTION_CONTROL. ENABLE  PREEMPTION; 
if  Flag  = -l  then 

raise  Sem_Exception; 
end  if; 


I in  1.. Length  loop 

if  (Addr  List (I)  < 0)  or  (AddrList (I)  > RCDT.SHM  SIZE-1)  then 
raise  Shm_Outrange ; — 

end  if; 

Temp  :=  Shmaddr  + system. of fset (Addr  List(I)); 
if  (Addr^List (I)  < RCDT. CHAR_OFFSET)  then 

Attr  List(l)  :=  (Type_ID  =>  0,  Int  Value  =>  RCDT. FINT (Temp) ) ; 
elsif  (Addr_List (I)  < RCDT.BOOLOFFSET)  then 

:=  (Type_ID  =>  1,  Char  Value  =>  RCDT.  FCHAR( Temp)  ) ; 
elsif  (Addr_List (I)  < RCDT. FLT_0FFSET7  then 

elsetr_LiSt^1^  !=  (Type-ID  =>  2'  Bool_value  =>  RCDT. FBOOL( Temp) ) ; 

endtif"rL^St  :=  ^Type-ID  =>  3'  Flt_Vaiue  =>  RCDT.  FFLT  (Temp)  ) ; 

end  loop; 

— delay  10.0; 


PREEMPTION_CONTROL. DISABLE_PREEMPTION ; 
Flag  :=  RCDT. READ END ( Semid ) ; 

--  PREEMPTION_CONTROL. ENABLE  PREEMPTION; 
if  Flag  = -l  then 

raise  Sem_Exception; 
end  if; 

end  Read_Attrs ; 


— Write  attributes  to  RODB  components 
procedure  Write_Attrs ( Addr_List  : in 

Length  : in 
Attr  List  : in 


RCDT . Pos_List_Type ; 
integer; 

RCDT. Attr_List_Type)  is 


Temp  : system. address; 

Flag  : integer; 
begin 

— PREEMPTION_CONTROL. DISABLE_PREEMPTION; 

Flag  :=  RCDT. WRITEBEG(Semid) ; 

— PREEMPTION_CONTROL . ENABLE_PREEMPTION ; 
if  Flag  = -l  then 

raise  Sem_Exception; 
end  if; 

for  I in  1..  Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr_List (I)  > RCDT.SHM  SIZE-1)  then 
raise  ShmOutrange ; ~ 

end  if; 

Temp  ;=  Shmaddr  + system. offset (Addr  List(I)); 
if  (Addr_List (I)  < RCDT . CHAR_OFFSET)  then 
RCDT. AINT( Temp,  Attr_List(I) .Int_Value) ; 
elsif  (Addr_List (I)  < RCDT. BOOL_OFFSET)  then 
RCDT . ACHAR ( Temp , Attr_List (I) . Char_Value) ; 
elsif  (Addr_List (I)  < RCDT. FLT_OFFSET)  then 
RCDT. ABOOL( Temp,  Attr_List (I) .Bool  Value); 
else  ~ 

RCDT. AFLT( Temp,  Attr_List ( I ) . Fit  Value); 
end  if;  ~ 

end  loop ; 

— delay  10.0; 

~ PREEMPTION_CONTROL. DISABLE  PREEMPTION; 

Flag  :»  RCDT.WRITEEND(Semid) ;~ 

— PREEMPTION_CONTROL . ENABLE  PREEMPTION; 

if  Flag  = -l  then  “ 

raise  Sem_Exception; 
end  if; 

end  Write_Attrs; 

Print  out  the  semaphore  values 
procedure  Print_Sems  is 
Flag  : integer; 
begin 

Flag  :=  RCDT.SEMPRINT(Semid) ; 
if  Flag  = -l  then 

raise  Sem_Exception; 
end  if; 

end  Print_Sems; 

— Load  RODB  Components  from  a disk  file. 

— The  structure  of  disk  file  is  as  following: 

Number_Of_Integers 
Positionl  Integerl 
Position2  Integer2 

Number_Of_Characters 
Positionl  Characterl 
Position2  Character2 

Number_Of_Booleans 
Positionl  Booleanl 
Position2  Boolean2 
« # « 

Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 


procedure  Load_Comps (Filename  : in  string)  is 
Infile  : FILE_TYPE; 

Temp  : system .address; 

Flag  : integer; 
begin 

open ( Infile,  in_file.  Filename); 

— Initialize  RODB  Integer  Component 
for  I in  1. .RCDT. INT_SIZE  loop 

Temp  :=  Shmaddr  + systera.offset ( (I-l)  *4) ; 

RCDT. AINT( Temp,  0) ; 
end  loop; 

Load_Ints( Infile) ; 

— Initialize  RODB  Character  Component 
for  I in  1. .RCDT.CHAR_SIZE  loop 

Temp  :=  Shmaddr  + system,  of  f set  (RCDT.  CHAR_OFFSET  + i-i)  ; 
RCDT. ACHAR (Temp,  'X'); 
end  loop ; 

Load_Chars (Infile) ; 

— Initialize  RODB  Boolean  Component 
for  I in  1. .RCDT.BOOL_SIZE  loop 

Temp  :=  Shmaddr  + system. offset  (RCDT.  BOOL  OFFSET  + 1-1); 
RCDT. ABOOL( Temp,  true) ; 
end  loop ; 

Load_Bools (Infile) ; 

— Initialize  RODB  Float  Component 
for  I in  1. . RCDT. FLT_SIZE  loop 

Temp  :=  Shmaddr  + system,  offset  (RCDT.  FLT  OFFSET  + (I-l)*4); 
RCDT. AFLT( Temp,  0.0); 
end  loop ; 

Load_Flts (Inf ile) ; 
close (Inf ile) ; 

Flag  :=  RCDT.SEMSINIT(Semid) ; 
if  Flag  = -1  then 
raise  Sem_Exception; 
end  if ; 

exception 

when  name_error  => 

put_line("File  cannot  be  opened."); 
put_line( "Loading  components  fails!"); 
when  data_error  | end_error  => 

put_line ( "File  format  is  incompatible."); 
put_line( "Loading  components  fails!"); 
when  Sem_Exception  => 

put_line ("Semaphore  cannot  be  initialized."); 
raise  Sem_Exception; 
when  others  => 

put_line ("Unknown  exception.") ; 
put_line ( "Loading  components  fails!"); 
end  Load_Comps; 

— Save  RODB  Components  to  a disk  file 


as  following: 


— The  structure  of  the  disk  file  is 
Number_Of_lntegers 
Positionl  Integerl 
Position2  Integer2 
# • • 

Number_Of_Characters 
Positionl  Characterl 
Position2  Character2 

Number_Of_Booleans 
Positionl  Booleanl 
Position2  Boolean2 


Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 


in  string)  is 


procedure  Save_Comps (Filename 
Outfile  : FILE_TYPE; 
begin 

if  Filename  /=  ""  then 

create (Outfile,  out_file.  Filename, 

Save_Ints  (Outfile);  f°™->""°rld->read,  ovner->read_write")  ; 
Save_chars( Out file) ; 

Save_Bools (Outfile) ; 

Save_Flts (Outfile) ; 
close (Outfile) ; 
else 


Save_Ints (TEXT_IO . standard  output) ; 
Save_Chars(TEXT_IO. standard  output) ; 
SaveBools ( TEXT  IO . standard~output ) ; 
Save_Flts (TEXT  10. standard  Output); 
end  if;  ~ 

exception 

when  constraint_error  => 

Put_^ ine ( "RODB  Components  data  collapsed.”)* 
Put_line( "Saving  components  fails!"); 
when  others  => 

Put_line( "Unknown  exception."); 
put_line( "Saving  components  fails!"); 
end  Save_Comps; 


Shutdown  RODB  Components 
procedure  Shutdown_Comps  is 
Flag  : integer; 
begin 

Flag  :*  RCDT . SHMDT ( Shmaddr ) ; 
if  Flag  » -i  then 
raise  Shm_Exception; 
end  if; 

RCDT*SHMCTL(sh®id,  0,  system. null  address); 
if  Flag  = -l  then  - 

raise  Shm_Exception; 
end  if; 

Flag  :=  RCDT. SEMSRMV(Semid) ; 
if  Flag  = -i  then 

raise  Sem_Exception; 
end  if; 

end  Shutdown_Comps ; 


pragma  page; 


— Load  all  the  integers  from  a disk  file  to  RODB  Integer  Component 
procedure  Load^_Ints  (Inf  ile  : in  FILE_TYPE)  is 

Length  : Tnteger ; 

Temp_Pos  : integer ; 

Temp_Int  : integer; 

Temp_Addr  : system. address; 
begin 

INT_IO.get (Inf ile.  Length); 

skip_line (Infile) ; 

for  I in  1.. Length  loop 

INT_IO.get (Inf ile,  Temp_Pos); 

INT_IO.get (Inf ile,  Temp_Int) ; 
skip_line( Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. INT_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :**  Shmaddr  + system. offset (Temp_Pos*4) ; 

RCDT . AINT ( Temp_Addr , Temp_Int) ; 
end  loop; 
end  Load_Ints; 

— Load  all  the  charaters  from  a disk  file  to  RODB  Character  Component 
procedure  Load Chars (Infile  : in  FILETYPE)  is 

Length  : Tnteger ; 

Temp_Pos  : integer ; 

Temp_Char  : character ; 

Temp_Addr  : system. address; 
begin 

INTIO. get (Infile,  Length); 

skip_line(Inf ile) ; 

for  I in  1 . . Length  loop 

INT_I0.get (Inf ile,  Temp_Pos) ; 

get(Infile,  Temp_Char) ; — Skip  a space 

get(Infile,  Temp_Char) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.CHAR_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :=  Shmaddr  + system. of f set (RCDT. CHAR_OFFSET+Temp_Pos) ; 
RCDT. ACHAR(Temp_Addr,  Temp_Char) ; 
end  loop; 
end  Load_Chars; 

— Load  all  the  booleans  from  a disk  file  to  RODB  Boolean  Component 
procedure  Load^Bools (Inf ile  : in  FILE_TYPE)  is 

Length  : Tnteger ; 

Temp_Pos  : integer ; 

Temp_Bool  : boolean; 

Temp_Addr  : system. address; 
begin 

INT_I0 . get ( Infile , Length); 

skip_line (Infile) ; 

for  I in  1 . . Length  loop 

INT_IO. get ( Inf ile,  Temp_Pos) ; 

BOOL__IO . get  (Infile,  Temp_Boo  1 ) ; 
skip_line(Inf ile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. BOOL_SIZE-l)  then 


raise  Shm_Out range; 
end  if; 

Temp_Addr  :=  Shmaddr  + system. of f set (RCDT. BOOL  OFFSET+Temp  pos 
RCDT . ABOOL ( Temp_Addr , Temp_Bool) ; ~ ' 

end  loop; 
end  Load_Bools; 


— Load  all  the  floats  from  a disk  file  to  RODB  Float  Component 
procedure  Load^Flts (Inf ile  : in  FILE  TYPE)  is 
Length  : Integer;  ~ 

Temp_Pos  : integer; 

Temp_Flt  : float; 

Temp_Addr  : system. address; 
begin 

INT_IO.get (Inf ile,  Length); 

skip_line (Infile) ; 

for  I in  1.. Length  loop 

INT_IO.get (Inf ile,  Temp_Pos); 

FLT_IO.get (Inf ile,  Temp_Flt) ; 
skip_line( Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.FLT  SIZE-1)  then 
raise  Shm_Outrange;  ~ 

end  if; 

Te®P_Addr  :=  Shmaddr  + system. of f set (RCDT. FLT  OFFSET+Temp  Pos*4)- 
RCDT . AFLT ( Temp_Addr , Temp_Flt) ; ~ — ' 

end  loop;  ~ 

end  Load  Fits; 


pragma  page; 


~ Save  aii  the  integers  from  RODB  Integer  Component  to 
procedure  Save_Ints(Outfile  : in  FILE  TYPE)  is 
Temp_Addr  : system. address;  “ 

begin 

put (Out file,  "Number  Of  Integers  is:  ") ; 

Int_IO.put (Outfile,  RCDT. INT  SIZE); 
new_line(Outf ile) ; “ 

for  I in  1. .RCDT. INT_SIZE  loop 
put(Outfile,  "Integer  number  "); 

Int_IO. put (Outfile,  I-l,  width  =>  5); 
put (Outfile,  ":"); 

Temp_Addr  :■  Shmaddr  + system. of fset ( (I-l) *4) ; 
Int_IO. put (Outfile,  RCDT. FINT (Temp  Addr) ) ; 
new_line (Outfile) ; 
end  loop; 
end  Save_Ints ; 


a disk  file 


Save  all  the  characters  from  RODB  Character  Component  to  a disk  fil« 
procedure  Save_Chars (Outfile  : in  FILE  TYPE)  is 
Temp_Addr  : system. address;  ~ 

begin 

put (Outfile,  "Number  Of  Characters  is:  ") ; 

IntlO.put (Outfile,  RCDT. CHAR  SIZE) ; 
new_line (Outfile) ; 
for  I in  1. .RCDT.CHAR_SIZE  loop 
put (Outfile,  "Character  number  ") ; 

Int_IO . put ( Outfile , I-l,  width  =>  5) ; 
put (Outfile,  ":"); 

Temp_Addr  :=  Shmaddr  + system. of fset (RCDT. CHAR  OFFSET  + I-l) • 
put (Outfile,  RCDT . FCHAR (Temp_Addr) ) ; 


new_line( Out file)  ; 
end  loop ; 
end  SaveChars; 

Save  all  the  booleans  from  RODB  Boolean  Component  to  a disk  file 
procedure  Save  Bools (Outfile  : in  FILE  TYPE!  is 

Temp_Addr  : System. address;  " ’ 

begin 

put (Outfile,  "Number  Of  Booleans  is:  "); 

Int_IO. put (Outfile,  RCDT.BOOL_SIZE) ; 
new_line (Outfile) ; 
for  I in  1. .RCDT.BOOL_SIZE  loop 
put (Outfile,  "Boolean  number  "); 

Int_IO. put (Outfile,  I-l,  width  =>  5)  ; 
put(Outfile, 

Temp_Addr  :=  Shmaddr  + system. offset (RCDT. BOOL  OFFSET  + I-l)  • 
Bool_IO. put (Outfile,  RCDT. FBOOL(TempAddr) ) ; ~ ' 

new_line (Outfile) ; 
end  loop ; 
end  Save_Bools; 

Save  all  the  floats  from  RODB  Float  Component  to  a disk  file 
procedure  Save_Flts (Outfile  : in  FILE  TYPE)  is 
Temp_Addr  : system. address;  ~ 

begin 

put (Outfile,  "Number  Of  Floats  is  ") ; 

Int_IO . put ( Out f i le , RCDT.FLT  SIZE); 
new_line (Outfile) ; ~ 

for  I in  1. .RCDT. FLTSIZE  loop 
put(Outfile,  "Float  number  ") ; 

Int_IO. put (Outfile,  I-l); 
put (Outfile,  ":"); 

Temp_Addr  :=  Shmaddr  + system. of f set (RCDT. FLT  OFFSET  + (I-l) *4)- 
Flt_IO. put (Outfile,  RCDT. FFLT (Temp  Addr) ) ; ~ 

new_line (Outfile) ; 
end  loop; 
end  Save_Flts; 

pragma  page; 

begin 

Shmid  :=  RCDT. SHMGET( RCDT. SHMKEY,  RCDT.SHM  SIZE,  1023); 
if  Shmid  = -l  then  ~ 

raise  Shm_Exception; 
end  if; 

Shmaddr  :=  RCDT. SHMAT( Shmid,  system. null  address,  0); 
if  Shmaddr  - system. null_address  then” 
raise  Shm_Exception; 

— end  if; 

Semid  :=  RCDT. SEMGET( RCDT. SEMKEY,  3,  1023); 
if  Semid  = -l  then 
raise  Sem_Exception; 
end  if; 

Initialize  the  RODB  Components 
Load_Comps( "rodbcomp.dat") ; 

end  Rodb_Component ; 
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Job:  readbeg.c 

Date:  Sat  Apr  11  23:40:14  1992 


/*  File:  readbeg.c  This  is  read  begin  subroutine  to  set  reading  protection  */ 
/include  <sys/ types . h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched. h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 

struct  sembuf  RREAD_START  = { 0,  1,  0}; 

struct  sembuf  RWAIT_NO_WRITE_LOCK  = { 1,  0,  Ob- 
struct sembuf  RWAIT_NO_WRITE_DESIRE  = { 2,  0,  0}; 

int  readbeg(semid) 
int  semid; 

{ 

struct  sembuf  one_of _n_readers [ 5 ] ; /*  Three  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid_t  my_tid; 

int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */  /*  Guarantee  atomic  ops  */ 
my_tid  = getstid(); 
my_prio  = getprio(getpid() ) ; 
fast_setprio(my_tid,  31); 

/*  Perform  three  semaphore  operations  *//*  Two  ops  are  repeated  */ 
one_of _n_readers [ 0 ] = RWAIT_NO_WRITE_LOCK;  /*  Wait  for  no  more  writer  */ 

one_of_n_readers [ 1 ] = RWAIT_NO_WRITE_DESIRE;  /*  Wait  for  no  more  writer  */ 

one_of_n_readers [ 2 ] = RWAIT_NO_WRITE_LOCK;  /*  Wait  for  no  more  writer  */ 

one_of_n_readers [ 3 ] = RWAIT_NO_WRITE_DESIRE;  /*  Wait  for  no  more  writer  */ 

one_of_n_readers ( 4 ] = RREAD_START;  /*  Prevent  writer  in  */ 

flag  = semop( semid,  one_of_n_readers,  5)  ; /*  Lock  the  critical  section  */ 

if  (flag  ==  -1)  { 

perror ("readbeg  fails:  ") ; 

} 

/*  Lower  the  priority  to  the  normal  */ 
fast_setprio(my_tid,  my_prio) ; 

return  flag; 
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Job:  readend.c 

Date:  Sat  Apr  11  23:40:15  1992 


/*  File: 
/include 
/include 
/include 
/include 
/include 


readend.c  This  is  read  end  subroutine  to  reset  protection 
<sys / types . h> 

<sys/ipc.h> 

<sys/sem.h> 

<sys/sched.h> 

<st.h> 


*/ 


/*  The  operations  on  the  semaphore  */ 
struct  sembuf  RREAD_END  = { 0,  -1,  0}; 

int  readend(semid) 
int  semid; 

{ 

int  flag; 
void  perror ( ) ; 
tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  preemption  */ 
my_tid  = getstid(); 
my_prio  = getprio(getpid() ) ; 
fast_setprio(my_tid,  31); 

/*  Perform  the  semaphore  operation  */ 

flag  * semop ( semid , &RREAD  END,  1);  /*  Unlock  critical  section  */ 

if  (flag  — -l)  { 

perror ("readend  fails:  M) ; 

} 

/*  Lower  the  priority  to  the  normal  */ 
fast_setprio(my_tid,  myprio) ; 

return  flag; 
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Job:  writebeg.c 

Date:  Sat  Apr  11  23:40:11  1992 


/*  File:  writebeg.c  This  is  the  write  begin  subroutine  to  set  protection  */ 
/include  <sys/ types . h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched. h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 

struct  sembuf  WWAIT_NO_READERS  = { 0,  0,  0}; 

struct  sembuf  WREAD_ST ART  = { 0,  1,  0>;  /*lock  out  another  writer*/ 

struct  sembuf  WWRITE_LOCK  = { 1,  1,  0>; 

struct  sembuf  WWRITE_DESIRE  = { 2,  1,0}; 

struct  sembuf  WIN_PROGRESS_WRITE  = { 2,  -1,  0};  /*  unlock  write  desire#  */ 

/*  /Guarantees  writer  progress  */ 

int  writebeg(semid) 
int  semid; 

{ 

struct  sembuf  sole_writer [4 ] ; /*  Four  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid_t  my_tid; 

int  my__prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  = getstid(); 
my_prio  = getprio(getpid() ) ; 
fast_setprio(my_tid,  31); 

/*  Make  write  request  by  doing  a semaphore  operation  */ 
flag  = semop(semid,  &WWRITE_DESIRE,  1) ; 
if  (flag  ==  -1)  { 

perror ("Write-Request  in  writebeg  fails:  ") ; 
return  flag; 

} 

/*  Perform  four  semaphore  operations  */ 

sole_wr iter [ 0 ] = WWAIT_NO_READERS ; /*  Wait  for  no  more  readers  */ 

s°le_writer(l]  = WWRITE_L0CK;  /*  preventing  succeeding  readers  */ 

s°le_writer [2 ] = WREAD_START;  /*  preventing  succeeding  writers  */ 

sole_wr iter [ 3 ] = WIN_PROGRESS_WRITE;  /*  Cancel  the  write-request#  */ 

flag  = semop( semid,  sole  writer,  4);  /*  Lock  the  critical  section  */ 

if  (flag  ==  -1)  { 

perror ("Write_Start  in  writebeg  fails:  "); 

} 

/*  /Note  cancelling  the  write-request  allows  another  writer  to  lock  it  * / 

/*  Lower  the  priority  to  the  normal  */ 
fast_setprio(my_tid,  my_prio) ; 

return  flag; 
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Job:  writeend.c 

Date:  Sat  Apr  11  23:40:13  1992 


/*  File:  writeend.c  This  is  write  end  subroutine  to  reset  write  protection  */ 
/include  <sys/ types . h> 

/include  <sys/ipc.h> 

/include  <sys/ sen . h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 
struct  sembuf  WREAD_END  = { o,  -1,  0}; 

struct  sembuf  WWRITE_UNLOCK  = { 1,  -1,  0}; 

int  writeend(semid) 
int  semid; 

{ 

struct  sembuf  sole_writer(2] ; /*  Two  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid_t  my_tid; 

int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  * getstidQ; 
my_prio  * getprio(getpid( ) ) ; 
fast_setprio(my_tid,  31); 

/*  Perform  the  semaphore  operation  */ 

sole_writer[0]  = WREAD_END;  /*  Allow  writer  in  */ 

sole_wr iter [ 1 ] = WWRITE_UNLOCK;  /*  Allow  reader  in  */ 

flag  = semop( semid,  sole_writer,  2) ; /*  Unlock  critical  section  */ 

if  (flag  ==  -1)  { 

perror ("writeend  fails:  ") ; 

} 

/♦-Lower  the  priority  to  the  normal  */ 
fast_setprio(my_tid,  my_prio) ; 

return  flag; 
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Job:  rodbcomp.dat 

Date:  Sat  Apr  11  22:34:04  1992 
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Job:  rodbcompll. in 

Date:  Sat  Apr  11  23:02:10  1992 
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Job : rodbeomp 1 1 . ou t 

Date:  Sat  Apr  11  23:02:22  1992 
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Job:  rodbcompl2 . in 

Date:  Sat  Apr  11  23:02:41  1992 
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Job:  rodbcompl2 . out 

Date:  Sat  Apr  11  23:03:17  1992 


Task  Number  Of  Iterations  Times 


Reader 1 

5000 

25.99048 

Reader2 

5000 

25.98096 

Writer 

5000 

25.99048 

Appendix  D-2 


Concurrent  (Competing) 

Reader  and  Writer  Performance  Test 

No  Prevention  of  Preemption  but  with  Semaphore  Protection  of  RODB 
Component. 
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read . me 

: Mon  Apr  20  17:46:59  1992 


Job: 

Date 


THERE  ARE  THREE  TASKS  RUNNING  IN  THE  SYSTEM:  TWO  READERS  AND  ONE  WRITER 
THEY  ARE  ACCESSING  THE  RODB  COMPONENT  WHICH  IS  PROTECTED  BY  A MECHANISM 
IN  RODBTSTE1 , ALL  THE  TASKS  HAVE  THE  SAME  PRIORITIES.  THE  RESULTS  ARE  I 
FILES  RODBCOMP1 . OUT  (RODBCOMP11 . OUT  AND  RODBCOMP12 . OUT)  for  5000  reads 
5000  writes  as  well  as  10000  reads  and  5000  writes  respectively.  THESE 
CORRESPOND  to  INPUT  FILES  RODBCOMP1.IN  (RODBCOMP11 . IN  and  RODBCOMP12 . IN 

This  directory  stores  all  the  files  to  build  up  RODB  "attribute”  componen 
The  protection  mechanism  is  that  locking  is  set  at  the  RODB  level.  During 
lock  setting,  there  is  NO  prevention  of  preemption.  Inside  the  C function 
the  fast_setprio  system  calls  are  commented  out.  There  is  only  one  set  of 
UNIX  semaphores  in  the  whole  system.  Before  actual  reading,  a set  of  five 
semaphore  operations  are  imposed  on  the  semaphores.  After  a read,  one 
semaphore  operation  is  imposed  on  a semaphore  (decreasing  reader  count) . 
Before  writing  there  are  two  levels  of  semaphore  operations  which  are 
imposed;  namely,  write-desire  and  write-lock.  For  write-desire  only  one 
semaphore  operation  is  imposed  on  its  semaphore  (tests lock)  and  when  that 
set  and  the  last  reader  has  finished,  then,  write-lock  is  set  as  one  of  a 
of  four  semaphore  operations  imposed  on  the  semaphores.  After  the  writer 
finishes  writing,  a set  of  two  semaphore  operations  are  imposed  on  the 
semaphores  (unlocking  the  RODB  to  allow  readers  or  other  writer  in) . 

THE  INTENT  IS  TO  DETERMINE  THE  EFFECT  OF  NOT  USING  PRIORITY  RAISE/LOWER 
MANIPULATION  WHICH  FORMERLY  GUARANTEED  THE  ATOMIC  NATURE  OF  THE  SEMAPHORE 
OPERATIONS.  THIS  TEST  IS  WITHOUT  THAT  COST. 


Appendix  D-3 


Simulated  RODB 

Concurrent  (Competing),  Reads  and  Writes 

Prevention  of  Preemption  Disabled 
Semaphore  Protection  Disabled 
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: Wed  Apr  15  19:28:49  1992 


Job: 

Date 


THERE  ARE  THREE  TASKS  RUNNING  IN  THE  SYSTEM:  TWO  READERS  AND  ONE  WRITER 
THEY  ARE  ACCESSING  TO  THE  RODB  COMPONENT  WHICH  IS  NOT  NOW  PROTECTED  BY 
A MECHANISM.  IN  RodbtstFl  ALL  THE  TASKS  HAVE  THE  SAME  PRIORITY.  THE 
RESULTS  ARE  IN  FILES  RODBCOMP1 . OUT (RODBCOMP11 . OUT  AND  RODBCOMP12 . OUT) 

THE  CORRESPONDING  INPUT  FILES  ARE  FILES  RODBCOMP1.IN  (RODBCOMP11 . IN 
AND  RODBCOMP12 . IN) . 

This  directory  stores  all  the  files  to  build  up  a RODB  "attribute"  compom 
The  protection  mechanism  of  locking  at  the  RODB  level  is  disabled.  The 
prevention  of  preemption  to  protect  the  locking  semaphores  is  also  disable 
All  of  the  protection  was  formerly  done  inside  four  C functions  which  usee 
the  fast_setprio  system  call  and  the  semop  system  call.  There  one  set  of  t 
UNIX  semaphores  formerly  used  in  the  whole  system.  Now,  all  these  system  c 
are  disabled  and  no  reade/writer  protection  is  provided.  While  this  would 
contribute  to  corrupt  data  items  being  read,  the  test  was  performed  to  see 
the  time  it  would  take  for  competing  reads  and  writes  in  the  "raw".  Of  coi 
now  the  overhead  of  calling  the  read  and  write  beginning  and  ending  functi 
is  of  little  use,  but  they  were  left  in  the  system  to  provide  a method  of 
isolating  the  costs  of  the  protection  mechanisms. 


Appendix  E 


Concurrent  (Competing)  Reads  and  Writes 


Code  for  demonstrating  the  lack  of  mutual  exclusion  in  a critical  sec- 
tion for  reading/writing  to  a simulated  RODB  component.  The  lack  of 
mutual  exclusion  is  presumably  caused  by  the  non-atomic  nature  of 
the  semop  system-call  algorithm  for  an  array  of  semaphores. 
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Job:  read.me 

Date:  Tue  Apr  14  22:24:53  1992 


This  directory  stores  all  the  files  to  build  up  an  RODB  "attribute"  compc 

The  protection  mechanism  is  that  locking  is  set  at  the  RODB  level.  During 

T^C»v,Settlng'  there  is  N0  prevention  of  preemption.  WE  ASSUME  A SYSTEM  CP 
IS  AN  ATOMIC  ACTION.  Assume  there  is  one  set  of  three  UNIX  semaphores  in 
whole  system.  Before  actual  reading,  a set  of  THREE  semaphore  operations 
be  imposed  on  the  semaphores.  After  actual  reading  one  semaphore  array 
operation  will  be  imposed  on  the  semaphores.  Before  actual  writing  there 

are  two  levels  of  operations:  y ere 

write-intent  on  one  level  and  write-lock  and  read-lock  on  the  other. 

F°r  write-intent  only  one  semaphore  operation  will  be  imposed  on  the  sema 
and  for  write-lock  a set  of  four  semaphore  operations  will  be  ordinarilv 
imposed  on  the  semaphores  (i.e.  including  test  of  read-lock  semaphore 
increase  read-lock,  set  write-lock  and  clear  write-intent  semaphore) . 

BUT  ON  LYNX  SEMAPHORE  OPERATIONS,  IF  A PROCESS  EXECUTING  SEMOP  IS  PREEMPT 

OR  EVEN  SLEEPS  ON  A SEMAPHORE  EVENT,  THERE  IS  NO  GUARANTEE 

THAT  SEMOP  WILL  RESUME  AT  THE  VERY  BEGINNING  OF  THE  SEMOP  ALGORITHM. 

After  actual  writing,  a set  of  two  release-semaphore  operations  will  ordii 
ce  imposed  on  the  semaphores. 

IN  THIS  PROGRAM,  A PAUSE  HAS  BEEN  INTRODUCED  IN  THE  WRITER  "CODE" 

UHi^Te^rL™0  OPERATIONS  (VIZ.  WRITER  LOCK  AND  READER  LOCK)  ARE  NOT  REI 
WHAT  THIS  TEST  SHOWS  IS  FACT  THAT  IF  THE  READER  HAS  SLEPT  ON  THE  WRITER  Tf 
SEMAPHORE  THAT  HAD  BEEN  ACTIVATED  BY  THE  WRITER  AND  NOW  HAD  BEEN  RELEASED 
THE  READER  HOW  IS  AWAKENED,  IT  SHOULD,  BUT  WILL  HOT  GO  BACK  TO  THE^BEGIHN] 
Dpcm!peALGORITHM  T°  CHECK  THE  STATUS  OF  THE  WRITER  LOCK  SEMAPHORE,  INSTEAt 
IT  LEFT  0FP  AND  0NLY  CHECKS  THE  WRITER  INTENT  SEMAPHORE  WHIC 

SStJSZ  SkSSTiaSi " B0™ A ™ A ™ITER  ™ 

is  done  a menu  will  appear  for  each  process  on  its  respective  terminal  scr 

SlLPr£CeS/ .should  choose  option  "4"  to  load  the  shared  memory  and  press  t 
enter  key  (l.e.  <CR>) . The  question  is  then  "asked"  for  the  name  of?the 
file  from  which  to  load  the  contents  of  the  shared  memory.  The  simplest  is 
to  press  Enter  since  there  is  a default  data  file  which  will  be  loaded  b 
h3eSStng^he  En5®r  key  (i»e»<CR>)*  Once  this  is  done  the  memory  may  be  vie 
Snn?HSShln9  °P5lon  l:  Then'  when  the  ”>enu  appears  again,  this  first  termi 
V °ptlon  1H  to  read  a l^t  of  attributes  followed  by  <CR> 
When  the  question  is  asked  "how  many"  the  simplest  answer  is  to  type  1 <CR 
The  question  will  then  be  raised  as  to  the  address  to  be  "read",  the  simpl 
answer  is  to  type  the  number  "0"  (without  the  quotes)  BUT  DO  NOT  PRESS  "En 
Then  set  up  the  next  terminal  by  running  another  copy  of  rodb  test7  and  ch 
L t0  write  a llst  of  attributes  <CR>.  Then,  when  the  question 

"auest ioi«rwM?WKmanyu'^the  ansYer  is  to  type  1 <CR>-  As  before  the  addres 
question  will  be  asked.  Type  m the  number  "0"  as  before  followed  by  <CR 

The  question  will  then  be  asked  for  the  value  to  be  written.  You  may  type 
some  integer  such  as  200  (the  number  100  is  the  default  at  address  o) . 

S°  N°T  TYPl<CR>.°r  Ent6r  M Then  start  the  third  process  from  the 
THIRD  terminal.  This  time  choose  the  option  "1"  again  to  read.  Again  selec 
one  (1)  attribute  and  again  select  address  f,0M  BUT  DO  NOT  TYPE  <CR>. 

NOW,  go  back  to  terminal  one  (1)  and  press  Enter  (<CR>) . Right  after  that 
(less  that  five  seconds  ) press  Enter  (<CR>)  on  terminal  two  (2). 

After  that  (less  than  five  but  more  than  two  seconds)  press  "Enter" 
on  terminal  three  (3) . Clearly  the  first  process  will  encounter  the 


semaphores  before  process  two  and  will  lock  out  process  two  since  it  will 
increase  the  reader  semaphore.  Process  two  (2)  will  set  the  write-intent 
semaphore  but  will  block  on  the  reader  semaphore.  Process  three  (3)  will 
test  the  write— lock  semaphore  and  find  it  NOT  set  (Process  one  (l)  is 
structured  to  stay  in  the  "reader"critical  section  about  ten  seconds  so 
the  writer  will  be  "locked  out".  HOWEVER,  Process  three  (3)  will  find  the 
write— intent  semaphore  set  so  it  will  "sleep"  on  the  event  that  the 
write-intent  semaphore  is  "cleared".  Meanwhile  eventually  — after  ten 
seconds  the  first  reader  finishes  and  "clears"  the  reader  semaphore. 
Immediately  the  the  second  process  (2)  will  wake  to  find  the  reader  semaphore 
to  be  zero.  This  writer  process  (2)  will  then  set  the  "write-lock"  semaphore 
but  will  release  the  write-intent  semaphore  so  as  to  allow  higher  priority 
readers  to  wake  up  and  sleep  on  the  "write-lock"  semaphore  rather  than  the 
"write-intent"  semaphore  (2)  then  enters  the  critical  section  to  access  the 
RODB  Component.  THIS  IS  WHERE  THE  PROBLEM  APPEARS  since  process  three  (3) 
apparently  does  wake  up  BUT  DOES  NOT  "GO  TO  START"  and  recheck  the  "writelock" 
semaphore  and  the  "write-intent"  semaphore  but  rather  just  continues  on 
by  (perhaps)  not  checking  the  "write-lock"  semaphore  but  only  the  "write-intent" 
semaphore  and  finding  it  "clear"  AND  then  it  increases  the  "read-lock"  semaphore 
3Jid  reads  the  shared  memory.  It  is  thus  reading  the  shared  memory  at  essentially 
shared  memory.  You  will  see  the  process  three  write  out  what  it  has  read 
and  terminate.  Process  two  (2),  which  started  before  process  three  (3)  is 
blocked  at  its  "pause"  statement  just  before  accessing  the  shared  memory. 

Process  three  (3)  finishes  even  though  it  should  be  blocked  from  entering 
by  the  "write_lock"  semaphore  set  by  process  two  (2) . 

Hence  the  Lynx  semop  algorithm  does  not  meet  the  System  V requirements 
and  further  even  if  it  did  in  the  non-preemptive  case,  it  might  fail 
under  the  real-time  preemptive  case.  That  is  to  say,  if  the  process 
does  not  sleep  but  is  preempted  during  the  execution  of  algorithm  semop 
when  it  resumed  it  would  not  know  that  it  had  been  preempted  and  would 
continue  on.  Thus  the  same  scenario  could  happen  as  above  even  if  the 
reader  process  did  not  sleep  but  was  preempted  by  an  high-priority 
just  before  it  increased  the  "read— lock"  semaphore. 
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Job: 

Date: 


rodb_test7.ada 

Tue  Apr  14  22:25:16  1992 


— | This  is  main  program  for  Test  of  Reader-Writer  mutex  problem  for  the  RODB 

— Component.  The  RODB_Component  is  represented  by  a small  Shared  Memory 

— Segment  which  is  set  up  by  functions  and  procedures  in  package  RODBCP  which 

— is  a ‘'rename"  for  package  RODB_COMPONENT_DATA_TYPES . Most  of  these  RODBCP 

— functions  are  Ada  names  for  C library  functions  and  UNIX  System  Calls. RODBC 

— operations  and  the  accessing  of  the  RODB  Shared  Memory  segment, 

use  TEXT_IO,  SYSTEM,  RODB_Component_Data_Types,  RODB  Component; 
procedure  Rodb_Test7  is  ~ 

ATTR_SIZE  : constant  integer  : = 20; 

package  RCDT  renames  RODB_Component_Data_Types ; 

package  RODBCP  renames  RODB_Component ; 

Length  : integer; 

Filename  : string ( 1. . 13) ; 

File_Len  : integer; 

Addr_List  : RCDT. Pos_List_Type (1 . . ATTR_SIZE) ; 

Attr_List  : RCDT. Attr_List_Type ( 1 . .ATTR_SIZE) ; 

Choice  : integer; 

— Input  a list  of  addresses  at  the  unit  of  bytes 

procedure  Input_Addr_List (AddrList  : in  out  RCDT.Pos_List_Type; 

Length  : in  integer)  is 

begin 

for  I in  1.. Length  loop 
put ("Address  number  ") ; 

INT_I0 . put ( I , width=>3 ) ; 
put ( " : " ) ; 

INT_IO . get ( Addr_Li s t ( I ) ) ; 
end  loop; 

end  Input_Addr_List; 

— Input  a list  of  attributes  according  to  their  addresses 

procedure  Input_Attr_List (AttrList  : in  out  RCDT. AttrListType; 

Length  : in  integer; 

AddrList  : in  RCDT.PosListType)  is 

An_Int  : integer; 

A_Char  : character; 

A_Bool  : boolean; 

A_Flt  : float; 
begin 

for  I in  1 . . Length  loop 

if  (Addr_List (I)  < RCDT. CHAR_OFFSET)  then 
put("Enter  an  attribute  integer:  "); 

INT_IO . get ( An_Int ) ; 

Attr_List(I)  :=  (Type_ID  =>  0,  Int_Value  =>  An_Int) ; 
elsif  (Addr_List (I)  < RCDT. BOOL_OFFSET)  then  « 
put ("Enter  an  attribute  character:  ") ; 
get(A_Char) ; 

Attr_List (I)  :=  (Type_ID  =>  1,  Char_Value  =>  A_Char) ; 

elsif  (Addr_List (I)  < RCDT. FLTOFFSET)  then 
put("Enter  an  attribute  boolean:  ")  ; 

BOOL_IO. get (A_Bool) ; 

Attr_List(I)  :=  (Type_ID  =>  2,  Bool_Value  =>  A_Bool) ; 
else 

put ("Enter  an  attribute  float:  ") ; 

FLT_IO.get(A_Flt) ; 

Attr_List (I)  :=  (Type_ID  =>  3,  Flt_Value  =>  A_Flt) ; 

end  if; 
end  loop; 

end  Input_Attr_List; 


Output  a list  of  Attributes  according  to  their  addresses 
procedure  Output_Attr_List (Attr_List  : in  RCDT . Attr_List_Type ; 

. Length  : in  integer)  is 

begin 

for  X in  1. . Length  loop 
put ("Attribute  number"); 

INT_IO . put ( I , width  =>  3)  ; 
put("  is  ")  ; 

case  Attr_List (I) .Type_ID  is 
when  0 => 

put ("Integer:  ") ; 

INT_IO . put ( Attr_List ( I ) . IntValue) ; 
when  1 => 

put ( "Character : " ) ; 
put (Attr_List (I) . Char_Value) ; 
when  2 => 

put ("Boolean:  "); 

BOOL_IO.put (AttrList (I) .BoolValue) ; 
when  3 => 

put ("Float:  "); 

FLT_IO. put (Attr_List (I) .FltValue) ; 
when  others  => 
null; 
end  case; 
new_line; 
end  loop ; 

end  OutputAttrList; 

begin 

loop 

Put_line("l Read  a list  of  attributes"); 

Put_line("2 Write  a list  of  attributes"); 

Put_lfne("3 print  out  the  shared  memory"); 

Pu't_line("4 Load  the  shared  memory"); 

put_line ("0 Exit"); 

put("Input  your  selection:  "); 

INT_I0. get (Choice) ; 
skip_line; 
case  Choice  is 
when  0 => 
exit; 
when  1 => 

put ( "How  many  attributes  do  you  want:  ") ; 

INT_IO. get (Length) ; 

Input_Addr_List (Addr_List,  Length) ; 

RODBCP . Read_Attrs (Addr_List , Length,  Attr  List); 

Output_Attr_List (Attr_List , Length); 
when  2 => 

put ( "How  many  attributes  do  you  want:  ") ; 

INT_I0. get ( Length) ; 

Input_Addr_List (Addr_List,  Length) ; 

Input_Attr_List (Attr_List,  Length,  Addr_List); 

RODBCP. Write_Attrs(Addr_List,  Length,  Attr  List) ; 
when  3 =>  ~ 

put ("Enter  the  filename  to  send  to (none  to  screen) : ") ; 
get_line(Filename,  File_Len) ; 

RODBCP . Save_Comps ( Filename ( 1 . . Fi le_Len) ) ; 
when  4 => 

put ( " Enter  the  filename  to  load  from(none  from  rodbcomp.dat) : ") ; 


get_line( Filename,  File_Len) ; 
if  (File_Len  /=  0)  then 

RODBCP . Load_Comps ( Filename ( 1 . . File_Len)  ) 
else 

RODBCP . Load_Comps ( "rodbcomp . dat " ) ; 
end  if ; 

■ when  others  => 

put_line ( "Input  error!"); 
end  case; 
end  loop; 

RODBCP . Shutdown_Comps ; 
exception 

when  Shm_Exception  => 

put_line ("Shared  memory  not  accessible."); 
when  Shm_Outrange  => 

put_line( "Shared  memory  out  of  range."); 
when  Sem_Exception  => 

put_line( "Semaphores  not  accessible."); 
end  Rodb Test 7; 
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— This  package  provides  the  constants,  instantiated  packages,  system  calls 

— and  C functions  interfaces  to  C language  for  RODB  COMPONENT  package, 
with  TEXT_IO , SYSTEM; 

use  TEXT_IO,  SYSTEM; 

package  ROD B_COMPON ENT_D AT A TYPES  is 


— Constants 


INT  SIZE 

constant 

integer 

: = 

10; 

CHAR  SIZE 

constant 

integer 

: = 

10; 

BOOL  SIZE 

constant 

integer 

: = 

10; 

FLT  SIZE 

constant 

integer 

: = 

10; 

SHMKEY 

constant 

integer 

: = 

99; 

SEMKEY 

constant 

integer 

: = 

100; 

SHM  SIZE 

constant 

integer 

: = 

INT  SIZE*4+CHAR  SIZE+BOOL  SIZE+4*FLT  SIZE 

CHAR  OFFSET 

constant 

integer 

: = 

INT  SIZE*4 ; 

BOOL  OFFSET 

constant 

integer 

: = 

CHAR  OFFSET  + CHAR  SIZE*1; 

FLT  OFFSET 

constant 

integer 

; = 

BOOLOFFSET  + BOOL_SIZE*l; 

— Data  types 

type  Attr_Type (Type_ID 

: integer  : 

= 0)  is  record 

case  Type_ID  is 
when  0 => 


Int_Value  : integer; 
when  1 => 

Char_Value  : character; 
when  2 => 

Bool_Value  : boolean; 
when  3 => 

Flt_Value  : float; 
when  others  => 
null; 
end  case; 
end  record; 

type  Attr_List_Type  is  array (integer  range  <>)  of  Attr_Type; 
type  Pos_List_Type  is  array (integer  range  <>)  of  integer; 

— Package  instantiation 

package  INT_IO  is  new  TEXT_IO. INTEGER_IO( integer ) ; 
package  BOOL_IO  is  new  TEXT_IO. ENUMERATION_IO( boolean) ; 
package  FLT_IO  is  new  TEXT_IO. FLOAT_IO (float)  ; 
function  FINT  is  new  system. fetch_from_address (integer) ; 
function  FCHAR  is  new  system. fetch_from_address (character) ; 
function  FBOOL  is  new  system. fetch_from_address (boolean) ; 
function  FFLT  is  new  system. fetch_from_address( float) ; 
procedure  AINT  is  new  system. assign_to_address (integer) ; 
procedure  ACHAR  is  new  system. ass ign_to_address (character) ; 
procedure  ABOOL  is  new  system. ass ign_to_address (boolean) ; 
procedure  AFLT  is  new  system . assign_to_address ( float ) ; 

— Shared  memory  system  call  interface 
function  SHMGET (KEY  : in  integer; 

SIZE  : in  integer; 

FLAG  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SHMGET); 
pragma  INTERFACE_NAME (SHMGET,  "shmget"); 
function  SHMAT (SHMID  : in  integer; 

SHMADDR  : in  system. address; 

FLAG  : in  integer)  return  system. address ; 

pragma  INTERFACE (C,  SHMAT) ; 
pragma  INTERFACE_NAME ( SHMAT,  "shmat"); 


function  SHMDT ( SHMADDR  : in  system. address)  return  integer; 

pragma  INTERFACE (C,  SHMDT); 

pragma  INTERFACE_NAME( SHMDT,  "shmdt"); 

function  SHMCTL ( SHMID  : in  integer; 

CMD  : in  integer; 

BUFF  : in  system. address)  return  integer; 

pragma  INTERFACE (C,  SHMCTL); 
pragma  INTERFACE_NAME( SHMCTL,  "shmctl") ; 

— Semaphore  system  call  and  C function  interface 
function  SEMGET (KEY  : in  integer; 

NSEMS  ; in  integer; 

FLAG  : in  integer)  return  integer; 

pragma  INTERFACE (C,  SEMGET); 
pragma  INTERFACE_NAME( SEMGET,  "semget") ; 
function  SEMSINIT(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMSINIT) ; 
pragma  INTERFACENAME (SEMSINIT,  "semsinit") ; 
function  READBEG(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READBEG); 
pragma  INTERFACENAME ( READBEG,  "readbeg") ; 
function  READEND(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READEND); 
pragma  INTERFACE  NAME (READEND,  "readend"); 
function  WRITEBEG(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEBEG); 
pragma  INTERFACE_NAME( WRITEBEG,  "writebeg"); 
function  WRITEEND (SEMID  : in  integer)  return  integer; 
pragma  INTERFACE ( C , WRITEEND); 
pragma  INTERFACE_NAME (WRITEEND,  "writeend"); 
function  SEMSRMV(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMSRMV) ; 
pragma  I NT ERFACE_NAME( SEMSRMV,  "semsrmv") ; 

end  RODB_Component_Data_Types ; 
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with  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
use  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
package  Rodb_Component  is  _ 

— Package  renaming 

package  RCDT  renames  Rodb_Component_Data_Types ; 

— Exception  definition 
Shm_Exception  : exception; 

Shm_Outrange  : exception; 

Sem_Exception  : exception; 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  out  RCDT. AttrListType) ; 

— Write  attributes  to  RODB  components 

procedure  Write_Attrs (Addr_List  : in  RCDT. Pos_List  Type; 

Length  : in  integer;  ~ 

Attr_List  : in  RCDT. Attr_List_Type) 

— Load  RODB  components  from  a disk  file 

procedure  Load_Comps (Filename  : in  string); 

— Save  RODB  components  to  a disk  file 

procedure  SaveComps (Filename  : in  string); 

— Shutdown  the  RODB  components 
procedure  Shutdown_Comps ; 


end  RODB_COMPONENT; 
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with  TEXT_IO,  CALENDAR,  SYSTEM,  Rodb_Component_Data_Types ; 
use  TEXT_IO , CALENDAR,  SYSTEM,  Rodb_Component~Data_Types ; 
package  body  Rodb_Component  is 

— Local  variables 
Shmid  : integer; 

Shmaddr  : system. address ; 

Semid  : integer; 

— Local  subprograms 

procedure  Load_Ints ( Inf ile  : in  FILE_TYPE) ; 

procedure  Load_Chars (Inf ile  : in  FILE” TYPE) ; 

procedure  Load_Bools (Inf ile  : in  FILE~TYPE) ; 

procedure  Load_Flts (Inf ile  : in  FILE_TYPE) ; 

procedure  Save_Ints (Outf ile  : in  FILE_TYPE) ; 

procedure  Save_Chars (Outf ile  : in  FILE_TYPE) ; 

procedure  Save_Bools (Outf ile  : in  FILE- TYPE) ; 

procedure  Save_Flts (Outf ile  : in  FILE~TYPE) ; 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT.Pos_List  Type; 

Length  : in  integer;  ~ 

Attr_List  : in  out  RCDT. Attr_List_Type)  is 
Temp  : system. address ; 

Flag  : integer; 
begin 

Flag  :=  RCDT. READBEG (Semid) ; 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1.. Length  loop 

if  (Addr_List (I)  < 0)  or  (AddrList (I)  > RCDT. SHMSIZE-l)  then 
raise  Shm_Outrange; 
end  if; 

Temp  :=  Shmaddr  + system. of fset (AddrList (I) ) ; 
if  (Addr_List (I)  < RCDT. CHAR_OFFSET)  then 

Attr_List(I)  :=  (Type_ID  =>  0,  Int_Value  =>  RCDT. FINT (Temp) ) ; 
elsif  (Addr_List (I)  < RCDT. BOOL_OFFSET)  then 

Attr_List(I)  :=  (Type_ID  =>  1,  Char_Value  =>  RCDT. FCHAR (Temp) ) ; 
elsif  (Addr_List (I)  < RCDT. FLT_OFFSET)  then 

Attr_List (I)  :=  (Type_ID  =>  2,  BoolValue  =>  RCDT . FBOOL (Temp) ) ; 

else 

Attr_List (I)  :=  (Type_ID  =>  3,  Flt_Value  =>  RCDT . FFLT (Temp) ) ; 

end  if; 
end  loop; 
delay  10.0; 

Flag  :=  RCDT. READEND( Semid ) ; 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

end  Read_Attrs ; 

— Write  attributes  to  RODB  components 
procedure  Write_Attrs ( Addr_List  : in 

Length  : in 
Attr_List  : in 
Temp  : system . address ; 

Flag  : integer; 
begin 

Flag  :=  RCDT . WRITEBEG (Semid); 


RCDT . Pos_L i s t_Ty pe ; 
integer; 

RCDT. Attr_List_Type)  is 


if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1..  Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr_List (I)  > RCDT. SHM_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp  :=  Shmaddr  + system. offset (Addr_List (I) ) ; 
if  (Addr_List (I)  < RCDT. CHAR_OFFSET)  then 
RCDT . AINT (Temp , Attr_List (I) . Int_Value) ; 
elsif  (Addr_List (I)  < RCDT. BOO L_OFFSET)  then 
RCDT. ACHAR( Temp,  Attr_List(I) .Char_Value) ; 
elsif  (Addr_List (I)  < RCDT. FLTOFFSET)  then 
RCDT. ABOOL( Temp,  Attr_List(I) .BoolValue) ; 
else 

RCDT. AFLT (Temp,  Attr_List(I) .FltValue); 
end  if ; 
end  loop; 
delay  10.0; 

Flag  :=  RCDT.WRITEEND(Semid) ; 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

end  Write_Attrs; 

— Load  RODB  Components  from  a disk  file. 

— The  structure  of  disk  file  is  as  following: 

— Number_Of_Integers 
Positionl  Integerl 

— Position2  Integer2 

— Number_Of_Characters 

— Positionl  Characterl 
Position2  Character2 

Number_Of_Booleans 
Positionl  Booleanl 
Position2  Boolean2 

Number_Of_Floats 

— Positionl  Floatl 
Position2  Float2 

procedure  Load_Comps (Filename  : in  string)  is 
Infile  : FILE_TYPE; 

Temp  : system. address; 

Flag  : integer; 

begin 

open(Infile,  in_file,  Filename) ; 

— Initialize  RODB  Integer  Component 
for  I in  1. .RCDT.INT_SIZE  loop 

Temp  :=  Shmaddr  + system. of f set ( (1-1)  *4)  ; 

RCDT. AINT (Temp,  0) ; 
end  loop; 

Load_Ints (Inf ile) ; 

— Initialize  RODB  Character  Component 
for  I in  1. .RCDT.CHAR_SIZE  loop 


Temp  :=  Shmaddr  + system. of f set (RCDT. CHAR_OFFSET  + 1-1)  ; 
RCDT . ACHAR ( Temp , 'X'); 

end  loop; 

Load_Chars (Inf ile) ; 

— Initialize  RODB  Boolean  Component 
for  I in  1. .RCDT.BOOL_SIZE  loop 

Temp  :=  Shmaddr  + system. of f set (RCDT. BOOL_OFFSET  + 1-1) ; 
RCDT. ABOOL( Temp,  true) ; “ 

end  loop; 

Load_Bools (Inf ile) ; 

— Initialize  RODB  Float  Component 
for  I in  1. . RCDT. FLT_SIZE  loop 

Temp  :=  Shmaddr  + system. offset (RCDT. FLT_OFFSET  + (I-l)*4); 
RCDT. AFLT (Temp,  0.0); 
end  loop; 

Load_Flts (Inf ile)  ; 
close(Inf ile) ; 

Flag  :=  RCDT. SEMSINIT (Semid) ; 
if  Flag  = -l  then 

raise  Sem_Exception; 
end  if; 

exception 

when  name_error  => 

put_line("File  cannot  be  opened."); 
put_line ( "Loading  components  fails!"); 
when  data_error  | end_error  => 

put_line("File  format  is  incompatible."); 
put_line ("Loading  components  fails!"); 
when  Sem_Exception  => 

put_line(" Semaphore  cannot  be  initialized."); 
raise  Sem_Exception; 
when  others  => 

put_line ("Unknown  exception.") ; 
put_line( "Loading  components  fails!"); 
end  Load_Comps; 

— Save  RODB  Components  to  a disk  file 

— The  structure  of  the  disk  file  is  as  following: 

Number_Of_Integers 

— Positionl  Integerl 
Position2  Integer2 

Number_Of_Characters 
Positionl  Characterl 
Position2  Character2 

Number_Of_Booleans 
Positionl  Booleanl 
Position2  Boolean2 

Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 
^ • • ♦ 

procedure  Save_Comps (Filename  : in 


string)  is 


Outfile  : FILE_TYPE; 
begin 

if  Filename  /=  ""  then 

create (Outfile,  out_file.  Filename, 

form=>"world=>read,  owner=>read_write" ) ; 

Save_Ints (Outfile) ; 

Save_Chars (Outfile) ; 

Save_Bools (Outfile)  ; 

Save_Flts (Outfile)  ; 
close (Outfile) ; 
else 

Save_Ints (TEXT_IO. standard_output) ; 

Save_Chars (TEXT_IO. standard_output) ; 

Save_Bools (TEXT_IO. standard_output) ; 

Save_Flts (TEXT_IO. standard_output) ; 
end  if; 
exception 

when  constraint_error  => 

put_line ("RODB  Components  data  collapsed."); 
put_line( "Saving  components  fails!"); 
when  others  => 

put_line( "Unknown  exception.”); 
put_line(" Saving  components  fails!"); 
end  Save_Comps; 

— Shutdown  RODB  Components 
procedure  Shutdown_Comps  is 

Flag  : integer; 
begin 

Flag  :=  RCDT.SHMDT(Shmaddr) ; 
if  Flag  = -1  then 

raise  Shm_Exception; 
end  if; 

Flag  :=  RCDT.SHMCTL(Shmid,  0,  system. null_address)  ; 
if  Flag  = -1  then 

raise  Shm_Exception; 
end  if; 

Flag  :=  RCDT.SEMSRMV(Semid) ; 
if  Flag  = -l  then 

raise  Sem_Exception; 
end  if ; 

end  Shutdown_Comps ; 
pragma  page; 

— Load  all  the  integers  from  a disk  file  to  RODB  Integer  Component 
procedure  Load  Ints( Infile  : in  FILETYPE)  is 

Length  : integer; 

Temp_Pos  : integer; 

Temp_Int  : integer; 

Temp_Addr  : system. address ; 
begin 

INT_IO.get (Inf ile,  Length); 

skip_line(Inf ile)  ; 

for  I in  1.. Length  loop 

INT_I0.get (Inf ile,  Temp_Pos) ; 

INT_I0.get (Inf ile,  Temp_Int)  ; 
skip_line(Inf ile) ; 

if  (Temp_Pos  < 0)  or  (TempPos  > RCDT. INT_SIZE-1)  then 
raise  Shm_Outrange; 


end  if; 

Temp_Addr  :=  Shmaddr  + system. of f set (Temp  Pos*4)# 
RCDT. AINT (Temp_Addr , Temp_Int) ; 
end  loop; 
end  Load_Ints; 


- Load  all  the  charaters  from 
procedure  Load^Chars (Inf ile  : 
Length  : Integer; 

Temp_Pos  : integer; 
Temp_Char  : character; 
Temp_Addr  : system. address; 
begin 


a disk  file  to  RODB  Character  Compo 
in  FILETYPE)  is 


nen 


INT_IO. get (Infile,  Length); 

skip_line( Infile) ; 

for  I in  1. .Length  loop 


INT_IO . get (Infile,  Temp_Pos ) ; 

get (Inf ile,  Temp_Char) ; — skip  a space 

get(Infile,  Temp_Char) ; 
skip_line (Inf ile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. CHAR  SIZE-1)  then 
raise  Shm_Outrange ; — 

end  if; 


Temp_Addr  :=  Shmaddr  + system. offset (RCDT. 
RCDT . ACHAR (Temp_Addr , Temp  Char); 
end  loop;  ~ 

end  Load_Chars ; 


CHAR_OFFSET+Temp_Pos ) 


Load  all  the  booleans  from  a disk  file  to  RODB 
procedure  Load^Bools (Inf ile  : in  FILE  TYPE)  is 
Length  : Integer ; — 

Temp_Pos  : integer; 

Temp_Bool  : boolean; 

TempAddr  : system. address ; 
begin 


Boolean 


Component 


INT_IO. get (Infile,  Length); 

skip_line ( Infile) ; 

for  I in  1.. Length  loop 

INT_I0.get (Inf ile,  Temp_Pos); 

B00L_I0.get (Inf ile,  Temp_Bool) ; 
skipline(Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. BOOL  SIZE-1)  then 
raise  Shm_Outrange ; — 

end  if;  ~ 


Temp_Addr  :=  Shmaddr  + system. of fset (RCDT. 
RCDT . ABOOL ( Temp_Addr , Temp  Bool); 
end  loop;  ~ 

end  Load_Bools; 


BOOL_OFFSET+Temp  Pos) 


Load  all  the  floats  from  a disk  file  to  RODB  Float 
procedure  Load_Flts (Inf ile  : in  FILE  TYPE)  is 
Length  : integer; 

Temp_Pos  : integer; 

Temp_Flt  : float; 

Temp_Addr  : system. address ; 
begin 

INT_I0 . get (Infile , Length); 

skip_line (Infile) ; 

for  I in  1 .. Length  loop 

INT_I0. get (Inf ile,  Temp_Pos) ; 


Component 


FLT_IO.get (Inf ile,  Temp_Flt) ; 
skip_line(Inf ile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. FLT_SIZE-1 ) then 
raise  Shm_Outrange ; 
end  if ; 

Temp_Addr  :=  Shmaddr  + system. of f set (RCDT. FLT_0FFSET+Temp_Pos*4 ) ; 
RCDT . AFLT ( Temp_Addr , Temp_Flt) ; 
end  loop ; 
end  Load_Flts; 

pragma  page; 

— Save  all  the  integers  from  RODB  Integer  Component  to  a disk  file 
procedure  Save_Ints (Outf ile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Integers  is:  ") ; 

Int_I0.put (Outf ile,  RCDT. INT_SIZE) ; 
new_line( Out file) ; 
for  I in  1. .RCDT.INT_SIZE  loop 
put (Outf ile,  "Integer  number  ")  ; 

Int_I0.put (Outfile,  1-1,  width  =>  5)  ; 
put (Outf ile,  ":"); 

Temp_Addr  :=  Shmaddr  + system. offset ( (1-1) *4) ; 

Int_I0. put (Outfile,  RCDT . FINT (Temp_Addr) ) ; 
new_line (Outf ile) ; 
end  loop ; 
end  Save_Ints; 

— Save  all  the  characters  from  RODB  Character  Component  to  a disk  file 
procedure  SaveChars (Outf ile  : in  FILETYPE)  is 

Temp_Addr  : system. address; 
begin 

put (Outf ile,  "Number  Of  Characters  is:  ")  ; 

IntlO.put (Outf ile,  RCDT.CHARSIZE) ; 

newline (Outf ile) ; 

for  I in  1. ,RCDT.CHAR_SIZE  loop 

put (Outfile,  "Character  number  ")  ; 

Int_IO. put (Outfile,  I-l,  width  =>  5) ; 
put (Outfile,  ":"); 

Temp_Addr  :=  Shmaddr  + system. offset (RCDT. CHAR_OFFSET  + I-l) ; 
put (Outfile,  RCDT. FCHAR(Temp_Addr) ) ; 
new_line (Outf ile) ; 
end  loop; 
end  Save_Chars; 

— Save  all  the  booleans  from  RODB  Boolean  Component  to  a disk  file 

procedure  Save_Bools (Outf ile  : in  FILETYPE)  is 

Temp_Addr  : system. address; 
begin 

put (Outfile,  "Number  Of  Booleans  is:  ")  ; 

Int_IO.put (Outf ile,  RCDT. BOOL_SIZE) ; 
new_line (Outf ile) ; 
for  I in  1. .RCDT. BOO L_SIZE  loop 
put(Outfile,  "Boolean  number  ")  ; 

Int_IO.put (Outf ile,  I-l,  width  =>  5)  ; 
put (Outfile,  ":"); 

Temp_Addr  :=  Shmaddr  + system. offset (RCDT. BOOL_OFFSET  4-  I-l) ; 
Bool_IO.put (Outf ile,  RCDT . FBOOL (Temp_Addr ) ) ; 
new_line (Outf ile) ; 


end  loop; 
end  Save_Bools; 


— Save  all  the  floats  from  RODB  Float  Component  to  a disk 
procedure  Save_Flts (Outf ile  : in  FILE  TYPE)  is 
Temp_Addr  : system. address;  ~ 

begin 

put (Outf ile,  "Number  Of  Floats  is  ") ; 

Int_IO. put (Outfile,  RCDT . FLT_S I Z E ) ; 
new_line (Outf ile) ; 
for  I in  1. .RCDT. FLT_SIZE  loop 
put (Outf ile,  "Float  number  ") ; 

Int_IO.put (Outfile,  1-1)  ; 
put (Outf ile, 

Temp_Addr  :=  Shmaddr  + system. offset (RCDT. FLT  OFFSET  + 
Flt_IO. put (Outfile,  RCDT. FFLT (Temp  Addr) ) ; 
new_line (Outf ile) ; ~ 

end  loop ; 
end  Save_Flts; 


file 


(1-1) *4) 


pragma  page; 
begin 

Shmid  :=  RCDT. SHMGET (RCDT. SHMKEY,  RCDT.SHM  SIZE.  1023)- 
if  Shmid  = -i  then  ~ 

raise  Shm_Exception; 
end  if; 

Shmaddr  :=  RCDT. SHMAT( Shmid,  system. null  address,  0) • 

— if  Shmaddr  = system. nulladdress  then- 

raise  Shm_Exception; 

— end  if; 

Semid  :=  RCDT. SEMGET (RCDT. SEMKEY,  3,  1023)* 
if  Semid  = -l  then  ' 

raise  Sem_Exception; 
end  if; 

end  Rodb_Component ; 
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Job:  readbeg. c 

Date:  Tue  Apr  14  22:37:57  1992 


/include 

/include 

/include 


<sys/ types. h> 
<sys/ipc.h> 
<sys/sem. h> 


/*  The  operations  on  semaphores  */ 
struct  sembuf  RREAD_S TART 
Struct  sembuf  RWAIT_NO_WRITE_LOCK 
struct  sembuf  RWAIT_NO_WRITE_DESIRE 

int  readbeg(semid) 
int  semid; 

{ 

struct  sembuf  one_of_n_readers[3] ; /*  Three  semaphore  operations  */ 

int  flag;  ' 

void  perror() ; 

/*  Perform  three  semaphore  operations  */ 

one_of_n_readers [ 0 ] = RWAIT_NO_WRITE_LOCK;  /*  Wait  for  no  more  wri 

°ne_of_n_readers [ 1 ] = RWAIT_NO_WRITE_DESIRE ; /*  Wait  for  no  more  wri 

one_of_n_readers [ 2 ] = RREAD_START ; /*  Prevent  writer  in  */ 

flag  - semop (semid,  oneofnreaders,  3);  /*  Lock  the  critical  sec 

if  (flag  = -1)  { 

perror ("readbeg  fails:  ”) ; 

> 

return  flag; 


= { 0/  1,  0}; 

= { 1,  0,  0 } ; 

= { 2,  0,  0}; 


t 

t 


r rrr 

oooo 

oooo 

ttttt 

rr  r 

o 

o 

o 

o 

t 

r 

o 

o 

o 

o 

t 

r 

o 

o 

o 

o 

t 

r 

o 

o 

o 

o 

t t 

r 

oooo 

oooo 

tt 

d 

d 

d 

d 

d 

d 

r rrr 

eeee 

aaaa 

ddd 

d 

eeee 

n 

nnn 

ddd 

d 

cccc 

rr  r 

e e 

a 

d 

dd 

e e 

nn 

n 

d 

dd 

c c 

r 

eeeeee 

aaaaa 

d 

d 

eeeeee 

n 

n 

d 

d 

c 

r 

e 

a a 

d 

d 

e 

n 

n 

d 

d 

c 

r 

e e 

a aa 

d 

dd 

e e 

n 

n 

d 

dd 

c c 

r 

eeee 

aaaa  a 

ddd 

d 

eeee 

n 

n 

ddd 

d 

# * 

cccc 

Job:  readend.c 

Date:  Tue  Apr  14  22:37:58  1992 


^include  <sys/ types . h> 

^include  <sys/ipc.h> 

^include  <sys/sem.h> 

/*  The  operations  on  the  semaphore  */ 
struct  sembuf  RREAD_END  = { 0,  -1,  0}; 

int  readend(semid) 
int  semid; 

{ 

int  flag; 
void  perror() ; 

/*  Perform  the  semaphore  operation  */ 

•ia<LT  semoP(semid'  &RREAD_END,  1);  /*  unlock  critical  section  */ 

if  (flag  ==  -l)  { ' 

perror ("readend  fails:  ")  ; 

} 

return  flag; 
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Job:  writebeg.c 

Date:  Tue  Apr  14  22:38:20  1992 


/include 

/include 

/include 


<sys/ types. h> 
<sys/ipc.h> 
<sys/sera. h> 


/*  The  operations  on  semaphores  */ 
struct  sembuf  WWAIT_NO_READERS  = 
struct  sembuf  WREAD_START  = 
struct  sembuf  WWRITE_LOCK  = 
struct  sembuf  WWRITE_DESIRE  = 
struct  sembuf  WIN  PROGRESS  WRITE  = 


{ 

0, 

0, 

o>  ; 

{ 

0, 

1, 

o>; 

{ 

1, 

1, 

0}; 

{ 

2, 

1, 

o>; 

{ 

2, 

-1, 

0}; 

int  writebeg (semid) 
int  semid; 

{ 

struct  sembuf  sole_writer [ 4 ] ; /*  Four  semaphore  operations  */ 

int  flag; 
void  perror() ; 

/*  Make  write  request  by  doing  a semaphore  operation  */ 
flag  = semop( semid,  £>WWRITE_DESIRE,  1)  ; 
if  (flag  ==  -1)  { 

perror ("Write-Request  in  writebeg  fails:  ")  ; 
return  flag; 

} 


/*  Perform  four  semaphore  operations  */ 

sole_writer[0]  = WWAIT_NO_READERS ; /*  Wait  for  no  more  readers  */ 

sole_writer( 1]  = WWRITE_LOCK;  /*  preventing  succeeding  reade 

sole_writer(2 ] = WREAD_START;  /*  preventing  succeeding  write 

sole_writer [ 3 ] = WIN_PROGRESS_WRITE;  /*  Cancel  the  write-request  */ 

flag  = semop( semid,  sole_writer,  4);  /*  Lock  the  critical  section  */ 

if  (flag  ==  -1)  { 

perror ("Write  Start  in  writebeg  fails:  ")  ; 

} 

pause ( ) ; 
return  flag; 
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Job:  writeend.c 

Date:  Tue  Apr  14  22:38:35  1992 


^include 

^include 

^include 


<sys/ types. h> 

<sys/ipc.h> 

<sys/sem.h> 


/*  The  operations  on  semaphores  */ 
struct  sembuf  WREAD_END  = { 0,  -1,  0}; 

struct  sembuf  WWRITE_UNLOCK  = { 1,  -1,  0}; 

int  writeend(semid) 
int  semid; 

{ 

struct  sembuf  sole_writer [2] ; /*  Two  semaphore  operations  */ 

int  flag; 
void  perror(); 

/*  Perform  the  semaphore  operation  */ 

sole_writer [0]  = WREAD_END;  /*  Allow  writer  in  */ 

sole_writer [ 1]  = WWRITEUNLOCK;  /*  Allow  reader  in  */ 

flag  = semop( semid,  sole_writer,  2) ; /*  Unlock  critical  section  */ 

if  (flag  ==  -1)  { 

perror ("writeend  fails:  ")  ; 

} 

return  flag; 
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Job:  semsinit.c 

Date:  Tue  Apr  14  22:38:55  1992 


/include  <sys/ types . h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semsinit (semid) 
int  semid; 

{ 

short  initarray [3 ] ; 
int  flag; 
void  perror(); 

initarrayfO]  = initarrayfl]  = initarray[2] 
flag  = semctl (semid,  3,  SETALL,  initarray) 
if  (flag  ==  -1)  { 

perror ( "semsinit  fails:  ")  ; 

} 

return (flag) ; 
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Job:  semsrmv.c 

Date:  Tue  Apr  14  22:39:02  1992 


#include  <sys/ types . h> 

#include  <sys/ipc.h> 

#include  <sys/sem.h> 
int  semsrmv( semid) 
int  semid; 

{ 

int  flag; 
void  perror(); 

flag  = semctl (semid,  3,  IPC_RMID,  0) ; 
if  (flag  ==  -1)  { 

perror ("semsrmv  fails:  ")  ; 

> 

return (flag) ; 

> 
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Job:  rodbcomp.dat 

Date:  Tue  Apr  14  22:41:09  1992 
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Appendix  D-2 


Concurrent  (Competing) 

Reader  and  Writer  Performance  Test 

No  Prevention  of  Preemption  but  with  Semaphore  Protection  of  RODB 
Component. 
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Job:  read. me 

Date:  Mon  Apr  20  17:46:59  1992 


THERE  ARE  THREE  TASKS  RUNNING  IN  THE  SYSTEM:  TWO  READERS  AND  ONE  WRITER 
THEY  ARE  ACCESSING  THE  RODB  COMPONENT  WHICH  IS  PROTECTED  BY  A MECHANISM 
IN  RODBTSTE1 , ALL  THE  TASKS  HAVE  THE  SAME  PRIORITIES.  THE  RESULTS  ARE  I 
FILES  RODBCOMP1 . OUT  ( RODBCOMP 1 1 . OUT  AND  RODBCOMP12 . OUT)  for  5000  reads 
5000  writes  as  well  as  10000  reads  and  5000  writes  respectively.  THESE 
CORRESPOND  to  INPUT  FILES  RODBCOMP1.IN  (RODBCOMP11. IN  and  RODBCOMP 12 . IN 

This  directory  stores  all  the  files  to  build  up  RODB  "attribute”  componer 
The  protection  mechanism  is  that  locking  is  set  at  the  RODB  level.  Durinc 
lock  setting,  there  is  NO  prevention  of  preemption.  Inside  the  C functior 
the  fast_setprio  system  calls  are  commented  out.  There  is  only  one  set  of 
UNIX  semaphores  in  the  whole  system.  Before  actual  reading,  a set  of  five 
semaphore  operations  are  imposed  on  the  semaphores.  After  a read,  one 
semaphore  operation  is  imposed  on  a semaphore  (decreasing  reader  count) . 
Before  writing  there  are  two  levels  of  semaphore  operations  which  are 
imposed;  namely,  write-desire  and  write-lock.  For  write-desire  only  one 
semaphore  operation  is  imposed  on  its  semaphore  (test&lock)  and  when  that 
set  and  the  last  reader  has  finished,  then,  write-lock  is  set  as  one  of  a 
of  four  semaphore  operations  imposed  on  the  semaphores.  After  the  writer 
finishes  writing,  a set  of  two  semaphore  operations  are  imposed  on  the 
semaphores  (unlocking  the  RODB  to  allow  readers  or  other  writer  in) . 

THE  INTENT  IS  TO  DETERMINE  THE  EFFECT  OF  NOT  USING  PRIORITY  RAISE/LOWER 
MANIPULATION  WHICH  FORMERLY  GUARANTEED  THE  ATOMIC  NATURE  OF  THE  SEMAPHORE 
OPERATIONS.  THIS  TEST  IS  WITHOUT  THAT  COST. 


Appendix  D-3 


Simulated  RODB 

Concurrent  (Competing),  Reads  and  Writes 

Prevention  of  Preemption  Disabled 
Semaphore  Protection  Disabled 
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: Wed  Apr  15  19:28:49  1992 


Job: 

Date 


THERE  ARE  THREE  TASKS  RUNNING  IN  THE  SYSTEM:  TWO  READERS  AND  ONE  WRITER 
THEY  ARE  ACCESSING  TO  THE  RODB  COMPONENT  WHICH  IS  NOT  NOW  PROTECTED  BY 
A MECHANISM.  IN  RodbtstFl  ALL  THE  TASKS  HAVE  THE  SAME  PRIORITY.  THE 
RESULTS  ARE  IN  FILES  RODBCOMP1 . OUT (RODBCOMP11 . OUT  AND  RODBCOMP12 . OUT) . 
THE  CORRESPONDING  INPUT  FILES  ARE  FILES  RODBCOMP1.IN  (RODBCOMP11 . IN 
AND  RODBCOMP12 . IN) . 

This  directory  stores  all  the  files  to  build  up  a RODB  "attribute"  compon. 
The  protection  mechanism  of  locking  at  the  RODB  level  is  disabled.  The 
prevention  of  preemption  to  protect  the  locking  semaphores  is  also  disable 
All  of  the  protection  was  formerly  done  inside  four  C functions  which  use< 
the  fast_setprio  system  call  and  the  semop  system  call.  There  one  set  of 
UNIX  semaphores  formerly  used  in  the  whole  system.  Now,  all  these  system  < 
are  disabled  and  no  reade/writer  protection  is  provided.  While  this  would 
contribute  to  corrupt  data  items  being  read,  the  test  was  performed  to  set 
the  time  it  would  take  for  competing  reads  and  writes  in  the  "raw".  Of  coi 
now  the  overhead  of  calling  the  read  and  write  beginning  and  ending  funct 
is  of  little  use,  but  they  were  left  in  the  system  to  provide  a method  of 
isolating  the  costs  of  the  protection  mechanisms. 


Appendix  E 


Concurrent  (Competing)  Reads  and  Writes 


Code  for  demonstrating  the  lack  of  mutual  exclusion  in  a critical  sec- 
tion for  reading/writing  to  a simulated  RODB  component.  The  lack  of 
mutual  exclusion  is  presumably  caused  by  the  non-atomic  nature  of 
the  semop  system-call  algorithm  for  an  array  of  semaphores. 
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Job:  read. me 

Date:  Tue  Apr  14  22:24:53  1992 


?HeSnS^Hry  stores  all  the  files  to  build  up  an  RODB  "attribute-  compc 

lockPsettina°nthpSaniSMr,1S  that  locklng  ls  set  at  the  RODB  level.  Durinc 
IS  AN  atomic' ACTION  a Prevention  of  preemption.  WE  ASSUME  A SYSTEM  C? 

li  Art  ATOMIC  ACTION.  Assume  there  is  one  set  of  three  UNIX  sem3nhnr0.  7 

the^eraaphores^Af  ter  * actual  ?ea™nf  Semaph°r*  °P«ations 


write-intent  on  one  level  and  write-lock  and  read-lock  on  the  other. 

For  write-intent  only  one  semaphore  operation  will  be  imnncioH  nn 

and  tor  write-look  a set  of  foSr  semaphore  operations  rin  b 

imposed  on  the  semaphores  (i.e.  including  test  of  read-lock  semanhor*  ly 

increase  read-lock,  set  write-lock  and  clear  write- inte^  semXreK 

BUT  ON  LYNX  SEMAPHORE  OPERATIONS,  IF  A PROCESS  EXEClITTNr  crunn  Tc.  „„ 

OR  EVEN  SLEEPS  ON  A SEMAPHORE  EVENT,  THERE  lf  NO  gSSeE  PREEMPT 

THAT  SEMOP  WILL  RESUME  AT  THE  VERY  BEGINNING  O^  TOE^OP  ALGORITHM. 

h^imposed^n'^the'semaphores?"  tW°  releas— Phore  operations  will  ordi 

IN  THIS  PROGRAM,  A PAUSE  HAS  BEEN  INTRODUCED  IN  THE  WRITFR  "rnnF« 

s^?s,,SoJs^s,sgi  “!“««  **  « 

?fA^ENEDTIST“o^DTHBU?R;TER  “D  N°W  B““  RELEASED 

s&ss  s^Hfs  S»“  resaws 

should  choSL0the0optio™n“  toe?eadea"!istaofeat?  “rt"'  fhlS  “rSt  termi 

ThenesetSut°thyPe  tJ®  nu”ber  ''0”  *“ithoitethedq“tes°  but  'do’not  press1"^ 

sroptLn^“%se^ijrf;!stbLraTin2  tanothar  c°p* ot  "“l  s 

"asked"  for  "how  m^i"  ?he  answer  ^ Then'  when-fhe  questior. 

"question”  will  be  asked  Tvno  in  1 <CR>,  As  before  the  addres 

tL  questio^lM;^  I^d^orWr^e  ?:  K 

Aq^n^lS  ??PE  <?R^or(El;«r"be™en0stL??heethUld  “ addr"SS  °>  ' 

THIRD  terminal.  This  time  choose'ihe  option  "1"  aqaii  toPreafSAoa?^  th? 
MOW  'lf  r-bUte  and  aHain  select  address  "0"  BUT  DO  NOT  TYPE  <CR>  6° 

”°”’T>  ba?k,to  ba™ihal  °he  (1)  and  press  Enter  (<CR>)  night  artel  that 

f ™ aaC°nrS  1 E””  Entar  (<CR>>  •>"  terminal  two  (!) 

After  that  (less  than  five  but  more  than  two  seconds)  press  "Enter" 

on  terminal  three  (3).  clearly  the  first  process  will  enl^nte!  rte 


semaphores  before  process  two  and  will  lock  out  process  two  since  it  will 
increase  the  reader  semaphore.  Process  two  (2)  will  set  the  write-intent 
semaphore  but  will  block  on  the  reader  semaphore.  Process  three  (3)  will 
test  the  write-lock  semaphore  and  find  it  NOT  set  (Process  one  (1)  is 
structured  to  stay  in  the  "reader"critical  section  about  ten  seconds  so 
the  writer  will  be  "locked  out".  HOWEVER,  Process  three  (3)  will  find  the 
write-intent  semaphore  set  so  it  will  "sleep"  on  the  event  that  the 
write-intent  semaphore  is  "cleared".  Meanwhile  eventually  — after  ten 
seconds  — the  first  reader  finishes  and  "clears"  the  reader  semaphore. 
Immediately  the  the  second  process  (2)  will  wake  to  find  the  reader  semaphore 
to  be  zero.  This  writer  process  (2)  will  then  set  the  "write-lock"  semaphore 
but  will  release  the  write-intent  semaphore  so  as  to  allow  higher  priority 
readers  to  wake  up  and  sleep  on  the  "write-lock"  semaphore  rather  than  the 
"write-intent"  semaphore  (2)  then  enters  the  critical  section  to  access  the 
RODB  Component.  THIS  IS  WHERE  THE  PROBLEM  APPEARS  since  process  three  (3) 
apparently  does  wake  up  BUT  DOES  NOT  "GO  TO  START"  and  recheck  the  "write  lock" 
semaphore  and  the  "write-intent"  semaphore  but  rather  just  continues  on 
by  (perhaps)  not  checking  the  "write-lock"  semaphore  but  only  the  "write-intent" 
semaphore  and  finding  it  "clear"  AND  then  it  increases  the  "read-lock"  semaphore 
and  reads  the  shared  memory.  It  is  thus  reading  the  shared  memory  at  essentially 
shared  memory.  You  will  see  the  process  three  write  out  what  it  has  read 
and  terminate.  Process  two  (2),  which  started  before  process  three  (3)  is 
blocked  at  its  "pause"  statement  just  before  accessing  the  shared  memory. 

Process  three  (3)  finishes  even  though  it  should  be  blocked  from  entering 
by  the  "write_lock"  semaphore  set  by  process  two  (2) . 

Hence  the  Lynx  semop  algorithm  does  not  meet  the  System  V requirements 
and  further  even  if  it  did  in  the  non-preemptive  case,  it  might  fail 
under  the  real-time  preemptive  case.  That  is  to  say,  if  the  process 
does  not  sleep  but  is  preempted  during  the  execution  of  algorithm  semop 
when  it  resumed  it  would  not  know  that  it  had  been  preempted  and  would 
continue  on.  Thus  the  same  scenario  could  happen  as  above  even  if  the 
reader  process  did  not  sleep  but  was  preempted  by  an  high-priority 
writer  just  before  it  increased  the  "read-lock"  semaphore. 
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Job:  rodb_test7 . ada 

Date:  Tue  Apr  14  22:25:16  1992 


— | This  is  main  program  for  Test  of  Reader-Writer  mutex  problem  for  the  RODB 

— Component.  The  RODB_Component  is  represented  by  a small  Shared  Memory 

— Segment  which  is  set  up  by  functions  and  procedures  in  package  RODBCP  which 

— is  a "rename"  for  package  RODB_COMPONENT_DATA_TYPES . Most  of  these  RODBCP 

— functions  are  Ada  names  for  C library  functions  and  UNIX  System  Calls. RODBC 

— operations  and  the  accessing  of  the  RODB  Shared  Memory  segment, 
use  TEXT_IO , SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
procedure  Rodb_Test7  is 

ATTR_SIZE  : constant  integer  :=  20; 

package  RCDT  renames  RODB_Component_Data_Types ; 

package  RODBCP  renames  RODB_Component ; 

Length  : integer; 

Filename  : string ( 1. . 13)  ; 

FileLen  : integer; 

Addr_List  : RCDT . Pos_List_Type ( 1 . . ATTR_SIZE) ; 

Attr_List  : RCDT . AttrListType ( 1 . . ATTRSIZE) ; 

Choice  : integer; 

— Input  a list  of  addresses  at  the  unit  of  bytes 

procedure  Input_Addr_List (Addr_List  : in  out  RCDT.Pos_List_Type; 

Length  : in  integer)  is 

begin 

for  I in  1.. Length  loop 
put ("Address  number  ")  ; 

INT_IO . put ( I , width=>3) ; 
put ( " : " ) ; 

INT_I0 . get ( Addr_List ( I ) ) ; 
end  loop; 

end  Input_Addr_List ; 

— Input  a list  of  attributes  according  to  their  addresses 

procedure  Input_Attr_List (Attr_List  : in  out  RCDT. Attr_List_Type; 

Length  : in  integer; 

Addr_List  : in  RCDT.Pos_List_Type)  is 

An_Int  : integer; 

A_Char  : character; 

A_Bool  : boolean; 

A_Flt  : float; 
begin 

for  I in  1.. Length  loop 

if  (Addr_List (I)  < RCDT. CHAR_OFFSET)  then 
put ("Enter  an  attribute  integer:  ")  ; 

INT_IO . get ( An_Int) ; 

Attr_List(I)  :=  (Type_ID  =>  0,  Int_Value  =>  An_Int) ; 
elsif  (Addr_List (I)  < RCDT. BOO L_0FFSET)  then  , 
put ("Enter  an  attribute  character:  ") ; 
get(A_Char) ; 

Attr_List(I)  :=  (Type_ID  =>  1,  Char_Value  =>  A_Char) ; 
elsif  (Addr_List (I)  < RCDT . FLT_OFFSET)  then 
put ("Enter  an  attribute  boolean:  ")  ; 

BOOL_IO.get (A_Bool) ; 

Attr_List (I)  :=  (Type_ID  =>  2,  Bool_Value  =>  A_Bool) ; 

else 

put ("Enter  an  attribute  float:  ") ; 

FLT_IO . ge t ( A_F It ) ; 

Attr_List (I)  :=  (Type_ID  =>  3,  Flt_Value  =>  A_Flt) ; 

end  i f ; 
end  loop; 

end  Input  Attr  List; 


Output  a list  of  Attributes  according  to  their  addresses 
procedure  Output_Attr_List (Attr_List  : in  RCDT . Attr_List_Type ; 
begin  Length  : in  integer)  is 

for  I in  1 . . Length  loop 
put ("Attribute  number"); 

INT_IO . put ( I , width  =>  3); 
put("  is  ")  ; 


case  Attr_List (I) .Type_ID  is 
when  0 => 

put ("Integer:  "); 

INT_IO . put ( Attr_List ( I ) .Int  Value) ; 
when  1 => 


put ("Character:  "); 
put ( Attr_List (I) . Char_Value) ; 
when  2 => 


put ("Boolean:  ") ; 

BOOL_IO . put ( Attr_List ( I ) .Bool  Value) ; 
when  3 =>  — 

put ("Float:  "); 

FLT_IO . put ( Attr_List ( I ) .FltValue) ; 
when  others  => 
null; 
end  case; 
new_line; 
end  loop; 

end  Output_Attr_List; 


begin 

loop 

Pu^_ line("i  Read  a list  of  attributes"); 

Pu^_ line("2  Write  a list  of  attributes"); 

put  line("3 print  out  the  shared  memory"); 

Put_llne("4 Load  the  shared  memory"); 

put_line ("0 Exit"); 

put ( "Input  your  selection:  ")  ; 

INT_IO. get (Choice) ; 
skipline; 
case  Choice  is 
when  0 => 
exit; 
when  1 => 

put ( "How  many  attributes  do  you  want:  ") • 

INT_I0. get (Length) ; 

Input_Addr_List(Addr_List,  Length) ; 

RODBCP. Read_Attrs (Addr_List,  Length,  Attr  List)* 
Output_Attr_List (Attr  List,  Length); 
when  2 =>  ~ 

put ("How  many  attributes  do  you  want:  ") • 

INT_I0. get (Length) ; 

Input_Addr_List (Addr_List,  Length) ; 

Input_Attr_List (Attr_List,  Length,  Addr  List) ; 

RODBCP. Write_Attrs(Addr  List,  Length,  Attr  List)  • 
when  3 =>  ~ —it 

put ("Enter  the  filename  to  send  to (none  to  screen) : " ) • 

9et_line (Filename,  File_Len) ; * ' 

RODBCP. Save  Comps (Filename ( 1 .. File  Len) ) • 
when  4 =>  ->!> 

put ( "Enter  the  filename  to  load  from(none  from  rodbcomp.dat):  " 


get_line (Filename,  File_Len) ; 
if  (File_Len  /=  0)  then 

RODBCP . Load_Comps (Filename ( 1 . . File_Len) ) 
else 

RODBCP • Load_Comps ( "rodbcomp . dat" ) ; 
end  if; 

when  others  => 

put_line ("Input  error!"); 
end  case; 
end  loop; 

RODBCP . Shutdown_Comps ; 
exception 

when  Shm_Exception  => 

put_line( "Shared  memory  not  accessible."); 
when  ShmOutrange  => 

put_line ( "Shared  memory  out  of  range."); 
when  Sem_Exception  => 

put_line( "Semaphores  not  accessible."); 
end  Rodb  Test7 ; 
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Job:  rodb_component_data_types 

Date:  Tue  Apr  14  22 : 25 : 41~1992 


— This  package  provides  the  constants,  instantiated  packages,  system  calls 

— and  C functions  interfaces  to  C language  for  RODB  COMPONENT  package, 
with  TEXT_IO , SYSTEM; 

use  TEXT_IO,  SYSTEM; 

package  RODB_COMPONENT_DATA_TYPES  is 


— Constants 


INT  SIZE 

constant 

integer 

: = 

10; 

CHAR  SIZE 

constant 

integer 

: = 

10; 

BOOL  SIZE 

constant 

integer 

: = 

10; 

FLT  SIZE 

constant 

integer 

: = 

10; 

SHMKEY 

constant 

integer 

: = 

99; 

SEMKEY 

constant 

integer 

: = 

100; 

SHM  SIZE 

constant 

integer 

: = 

INT  SIZE*4+CHAR  SIZE+BOOL  SIZE+4*FLT  SIZE 

CHAR  OFFSET 

constant 

integer 

: = 

INT  SIZE*4 ; 

BOOL  OFFSET 

constant 

integer 

: = 

CHAR  OFFSET  + CHAR  SIZE*1; 

FLT  OFFSET 

constant 

integer 

\ = 

B00L_0FFSET  + BOOL_SIZE*l; 

— Data  types 

type  Attr_Type (Type_ID 

: integer  : 

= 0)  is  record 

case  Type_ID  is 
when  0 => 


Int_Value  : integer; 
when  1 => 

Char_Value  : character; 
when  2 => 

Bool_Value  : boolean; 
when  3 => 

Flt_Value  : float; 
when  others  => 
null; 
end  case; 
end  record; 

type  Attr_List_Type  is  array (integer  range  <>)  of  Attr_Type; 
type  Pos_List_Type  is  array (integer  range  <>)  of  integer; 

— Package  instantiation 

package  INT_IO  is  new  TEXT_IO. INTEGER_IO( integer) ; 
package  BOOL_IO  is  new  TEXT_IO. ENUMERATION_IO( boolean) ; 
package  FLT_IO  is  new  TEXT_IO. FLOAT_IO( float)  ; 
function  FINT  is  new  system. fetch_f rom_address ( integer) ; 
function  FCHAR  is  new  system. fetch_from_address (character) ; 
function  FBOOL  is  new  system. fetch_frora_address (boolean) ; 
function  FFLT  is  new  system. fetch_from_address(f loat) ; 
procedure  AINT  is  new  system. assign_to_address ( integer) ; 
procedure  ACHAR  is  new  system. assign_to_address (character) ; 
procedure  ABOOL  is  new  system. assign_to_address (boolean) ; 
procedure  AFLT  is  new  system. assigntoaddress (float) ; 

— Shared  memory  system  call  interface 
function  SHMGET(KEY  : in  integer; 

SIZE  : in  integer; 

FLAG  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SHMGET) ; 
pragma  INTERFACE_NAME (SHMGET,  "shmget"); 
function  SHMAT(SHMID  : in  integer; 

SHMADDR  : in  system. address ; 

FLAG  : in  integer)  return  system. address ; 

pragma  INTERFACE (C,  SHMAT); 
pragma  INTERFACE_NAME (SHMAT,  "shmat") ; 


function  SHMDT ( SHMADDR  : in  system. address)  return  integer; 

pragma  INTERFACE (C,  SHMDT) ; 

pragma  INTERFACE_NAME (SHMDT,  "shmdt"); 

function  SHMCTL ( SHMID  : in  integer; 

CMD  : in  integer; 

BUFF  : in  system. address)  return  integer; 

pragma  INTERFACE (C,  SHMCTL) ; 
pragma  INTERFACE_NAME( SHMCTL,  "shmctl"); 

— Semaphore  system  call  and  C function  interface 
function  SEMGET (KEY  ; in  integer; 

NSEMS  ; in  integer; 

FLAG  : in  integer)  return  integer; 

pragma  INTERFACE (C,  SEMGET) ; 
pragma  INTERFACE_NAME (SEMGET,  "semget”) ; 
function  SEMSINIT(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMSINIT) ; 
pragma  INTERFACE_NAME( SEMSINIT,  "semsinit"); 
function  READBEG ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READBEG); 
pragma  INTERFACE_NAME (READBEG,  "readbeg"); 
function  READEND (SEMID  ; in  integer)  return  integer; 
pragma  INTERFACE (C,  READEND); 
pragma  INTERFACE_NAME( READEND,  "readend"); 
function  WRITEBEG (SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEBEG); 
pragma  INTERFACE_NAME (WRITEBEG,  "writebeg"); 
function  WRITEEND( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEEND); 
pragma  INTERFACE_NAME (WRITEEND,  "writeend") ; 
function  SEMSRMV(SEMID  ; in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMSRMV) ; 
pragma  INTERFACE_NAME (SEMSRMV,  "semsrmv" ) ; 

end  RODB_Component_Data_Types ; 
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Job:  rodb_component_. ada 

Date:  Tue  Apr  14  22:25:57  1992 


with  TEXT_IO , SYSTEM,  Rodb_Component_Data_Types ; 
use  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
package  Rodb_Component  is 

— Package  renaming 

package  RCDT  renames  Rodb_Component_Data_Types ; 

— Exception  definition 
Shm_Exception  : exception; 

Shm_Outrange  : exception; 

Sem_Exception  : exception; 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT.Pos_List  Type; 

Length  : in  integer; 

Attr_List  : in  out  RCDT. Attr_List_Type) ; 

— Write  attributes  to  RODB  components 

procedure  Write_Attrs (Addr_List  : in  RCDT. Pos_List  Type; 

Length  : in  integer ; ~~ 

AttrList  : in  RCDT. Attr_List_Type) 

— Load  RODB  components  from  a disk  file 

procedure  Load_Comps (Filename  : in  string); 

— Save  RODB  components  to  a disk  file 

procedure  Save_Comps (Filename  : in  string); 

— Shutdown  the  RODB  components 
procedure  Shutdown_Comps ; 


end  RODB_COMPONENT; 
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Job:  rodb_component . ada 

Date:  Tue  Apr  14  22:37:48  1992 


with  TEXT_IO,  CALENDAR,  SYSTEM,  Rodb_Component  Data  Types; 
use  TEXT_IO,  CALENDAR,  SYSTEM,  Rodb_Component  Data  Types; 
package  body  Rodb_Component  is 

— Local  variables 
Shmid  : integer; 

Shmaddr  : system. address ; 

Seraid  : integer; 

— Local  subprograms 

procedure  Load_Ints ( Inf ile  : in  FILE_TYPE) ; 

procedure  Load_Chars (Inf ile  : in  FILE-TYPE) ; 

procedure  Load_Bools (Inf ile  : in  FILE- TYPE) ; 

procedure  Load_Flts (Inf ile  : in  FILE~TYPE) ; 

procedure  Save_Ints (Outf ile  : in  FILETYPE) ; 

procedure  Save_Chars (Outf ile  : in  FILE_TYPE) ; 

procedure  Save_Bools (Outf ile  : in  FILE- TYPE) ; 

procedure  Save_Flts (Outf ile  : in  FILE- TYPE) ; 

— Read  attributes  from  RODB  components 

procedure  ReadAttrs (AddrList  : in  RCDT. PosListType; 

Length  : in  integer;  — 

Attr_List  : in  out  RCDT. Attr_List  Type)  is 
Temp  : system. address; 

Flag  : integer; 
begin 

Flag  :=  RCDT. READBEG (Semid) ; 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1.. Length  loop 

if  ( Addr_List (I)  < 0)  or  (Addr_List (I)  > RCDT.SHM  SIZE-1)  then 
raise  Shm_Outrange; 
end  if; 

Temp  :=  Shmaddr  + system. of fset (Addr_List (I) ) ; 
if  (Addr_List (I)  < RCDT. CHAR_OFFSET)  then 

Attr_List(I)  :=  (Type_ID  =>  0,  Int_Value  =>  RCDT. FINT (Temp) ) ; 
elsif  (Addr_List (I)  < RCDT. BOO L_OFFSET)  then 

Attr_List (!)  :=  (Type_ID  =>  1,  Char_Value  =>  RCDT. FCHAR( Temp) ) ; 

elsif  (Addr_List (I)  < RCDT. FLTOFFSET)  then 

Attr_List(I)  :=  (Type  ID  =>  2,  Bool  Value  =>  RCDT. FBOOL( Temp) ) ; 
else  - ~ ' 

Attr_List(I)  :=  (Type  ID  =>  3,  Fit  Value  =>  RCDT. FFLT (Temp) ) ; 
end  if ; 
end  loop; 
delay  10.0; 

Flag  :=  RCDT. READ END (Semid) ; 
if  Flag  = -l  then 

raise  Sem_Exception; 
end  if; 

end  Read_Attrs; 

— Write  attributes  to  RODB  components 
procedure  Write_Attrs (Addr_List  : in 

Length  : in 
Attr_List  : in 
Temp  : system. address ; 

Flag  : integer; 
begin 

Flag  :=  RCDT . WRITEBEG (Semid); 


RCDT. Pos_List_Type ; 
integer; 

RCDT. Attr_List_Type)  is 


if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1..  Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr_List (I)  > RCDT. SHM_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp  :=  Shmaddr  + system. offset (Addr_List( I) ) ; 
if  (Addr_List (I)  < RCDT . CHAR_0FFSET)  then 
RCDT. AINT (Temp,  Attr_List(I) .Int_Value) ; 
elsif  (Addr_List (I)  < RCDT. B00L_0FFSET)  then 
RCDT. ACHAR( Temp,  Attr_List(I) .Char_Value) ; 
elsif  (Addr_List (I)  < RCDT. FLT_0FFSET)  then 
RCDT. AB00L( Temp,  Attr_List(I) .Bool_Value)  ; 
else 

RCDT. AFLT( Temp,  Attr_List(I) .Flt_Value); 
end  if; 
end  loop; 
delay  10.0; 

Flag  :=  RCDT.WRITEEND(Semid)  ; 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if ; 

end  Write_Attrs; 

— Load  RODB  Components  from  a disk  file. 

— The  structure  of  disk  file  is  as  following: 

Number_Of_Integers 
Positionl  Integerl 
Position2  Integer2 

Number_Of_Characters 
Positionl  Characterl 
Position2  Character2 

Number_Of_Booleans 

— Positionl  Booleanl 
Position2  Boolean2 

Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 

procedure  Load_Comps (Filename  : in  string)  is 
Infile  : FILEJTYPE; 

Temp  : system. address; 

Flag  : integer; 

begin 

open(Infile,  in_file,  Filename) ; 

— Initialize  RODB  Integer  Component 
for  I in  1. .RCDT. INT_SIZE  loop 

Temp  :=  Shmaddr  + system. offset( (1-1)  *4)  ; 

RCDT. AINT (Temp,  0) ; 
end  loop; 

Load_Ints (Infile)  ; 

— Initialize  RODB  Character  Component 
for  I in  1. .RCDT.CHAR_SIZE  loop 


Temp  :=  Shmaddr  + system . off  set ( RCDT . CHAR_OFFSET  + 1-1)  ; 
RCDT . ACHAR ( Temp , 'X'); 

end  loop; 

Load_Chars (Inf ile) ; 

— Initialize  RODB  Boolean  Component 
for  I in  1. .RCDT.BOOLSIZE  loop 

Temp  :=  Shmaddr  + system. offset (RCDT. BOO L_OFFSET  + 1-1) ; 
RCDT . ABOOL (Temp,  true) ; 
end  loop; 

Load_Bools (Inf ile) ; 

— Initialize  RODB  Float  Component 
for  I in  1. .RCDT. FLT_SIZE  loop 

Temp  :=  Shmaddr  + system. offset (RCDT. FLT_OFFSET  + (I-l)*4); 
RCDT. AFLT (Temp,  0.0); 
end  loop ; 

Load_Flts (Inf ile)  ; 
close(Inf ile) ; 

Flag  :=  RCDT. SEMSINIT (Semid) ; 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

exception 

when  name_error  => 

put_line("File  cannot  be  opened."); 
putline ("Loading  components  fails!"); 
when  data_error  | end_error  => 

put_line ( "File  format  is  incompatible."); 
put_line ( "Loading  components  fails!"); 
when  Sem_Exception  => 

put_line( "Semaphore  cannot  be  initialized."); 
raise  Sem_Exception; 
when  others  => 

put_line ( "Unknown  exception.") ; 
put_line( "Loading  components  fails!"); 
end  Load_Comps ; 

— Save  RODB  Components  to  a disk  file 

— The  structure  of  the  disk  file  is  as  following: 

Number_Of_Integers 
Positionl  Integerl 
Position2  Integer2 

Numbe r_0 f _Cha r a c t e r s 
Positionl  Characterl 
Position2  Character2 

Number_Of_Boo leans 
Positionl  Booleanl 
Position2  Boolean2 

Number_0f  Floats 
Positionl  Floatl 
Position2  Float2 

procedure  Save_Comps (Filename  : in 


string)  is 


Outfile  : FILE_TYPE; 
begin 

if  Filename  /=  ""  then 

create (Outfile,  out_file.  Filename, 

form=>"world=>read,  owner=>read_write" ) ; 

Save_Ints (Outfile) ; 

Save_Chars (Outfile) ; 

Save_Bools (Outfile)  ; 

Save_Flts (Outfile)  ; 
close (Outfile) ; 
else 

Save_Ints (TEXT_IO. standard_output) ; 

Save_Chars (TEXT_IO. standard_output)  ; 

Save_Bools (TEXT_IO. standard_output) ; 

Save_Flts (TEXT_IO . standard_output ) ; 
end  if; 
exception 

when  constraint_error  => 

put_line ("RODB  Components  data  collapsed."); 
put_line(" Saving  components  fails!"); 
when  others  => 

put_line ( "Unknown  exception . " ) ; 
put_line( "Saving  components  fails!"); 
end  Save_Comps; 

— Shutdown  RODB  Components 
procedure  Shutdown_Comps  is 

Flag  : integer; 
begin 

Flag  :=  RCDT.SHMDT(Shmaddr) ; 
if  Flag  = -1  then 

raise  Shm_Exception; 
end  if ; 

Flag  :=  RCDT. SHMCTL (Shmid,  0,  system. null_address) ; 
if  Flag  = -1  then 

raise  Shm_Exception; 
end  if; 

Flag  :=  RCDT. SEMSRMV(Semid) ; 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if ; 

end  Shutdown_Comps ; 
pragma  page; 

— Load  all  the  integers  from  a disk  file  to  RODB  Integer  Component 
procedure  Load  Ints(Infile  : in  FILETYPE)  is 

Length  : Tnteger ; 

Temp_Pos  : integer; 

Temp_Int  : integer; 

Temp_Addr  : system. address ; 
begin 

INT_IO. get (Infile,  Length); 

skip_line (Inf ile) ; 

for  I in  1.. Length  loop 

INT_I0.get (Inf ile,  Temp_Pos) ; 

INT_IO . get ( Infile , Temp_Int) ; 
skip_line (Inf ile) ; 

if  (Temp_Pos  < 0)  or  (TempPos  > RCDT. INT_SIZE-1)  then 
raise  Shm_Outrange; 


end  if; 

Temp_Addr  :=  Shmaddr  + system. of f set (Temn  p0s*4)  • 

RCDT . AINT ( Temp_Addr , Temp  Int)  ; ~ 4), 

end  loop ; 
end  Load_Ints; 

Load  all  the  charaters  from  a disk  file  to  roor  rhararfov 
procedure  Load  Chars  (Infile  : in  FILE  TYPE)  is  chara<=ter  Componen 

Length  : integer;  “ 

Temp_Pos  : integer; 

Temp_char  : character; 

Temp_Addr  : system. address; 
begin 

INT_IO.get (Inf ile.  Length) ; 

skipline (Infile) ; 

for  I in  1 . . Length  loop 

INT_IO.get (Inf ile,  Temp_Pos) ; 

get  (Infile,  Temp  Char);-  ckin  _ 

get(Infile,  Te»£char> ; klP  3 space 

skip_line( Infile) ; 

if  (Temp  Pos  < 0)  or  (Temp  Pos  > RCDT. CHAR  SIZE-1)  then 
raise  Shm_Outr ange ; - - ' nen 

end  if; 

RCOTTACHARdemp^Addr,  +Te^pt3Pg°^fset  ^RCDT' CHAR— 0FFSET+Temp_Pos> ! 
end  loop;  - ' 

end  Load_Chars; 

procedure  1Load^Bools ^ Inf i le°T  In^^F^T^EfS  B°°lean  CoroP°nent 

Length  : integer;  — 1 

Temppos  : integer; 

Temp_Bool  : boolean; 

Temp_Addr  : system. address; 
begin 

INT_IO. get (Inf ile.  Length); 

skip_line(Inf ile) ; 

for  I in  1.. Length  loop 

INT_IO.get (Inf ile.  Temp  Pos); 

BOOL_IO.get (Inf ile,  Temp  Bool) ; 
skipline(Infile) ; 

if  (Temp  Pos  < 0)  or  (Temp_Pos  > RCDT. BOOL  SIZE-1)  then 

raise  Shm Outrange;  ~ 

end  if; 

R;S?7^Li;e“r/TSrBoo!,t,Set(RCDT-BML-OFFSET+Te^ 

end  loop;  ~ ' 

end  Load  Bools; 


Load  all  the  floats  from  a d 
procedure  Load  Fits (Infile  : in 
Length  : Tnteger; 

Temp_Pos  : integer; 

Temp_Flt  : float; 

Temp_Addr  : system. address ; 
begin 


isk  file  to  RODB  Float  Component 
FILETYPE)  is 


INT_I0.get (Inf ile.  Length); 

skip_line(Infile) ; 

for  I in  1 .. Length  loop 

INT_I0.get (Inf ile,  Temp_Pos) ; 


skxp_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. FLT_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :=  Shmaddr  + system.offset(RCDT.FLT_OFFSET+Temp_Pos*4); 
RCDT. AFLT(Temp_Addr , Temp_Flt) ; ~ 

end  loop ; 
end  Load_Flts; 

pragma  page; 

— Save  all  the  integers  from  RODB  Integer  Component  to  a disk  file 
procedure  Save_Ints (Outf ile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put (Outf ile,  "Number  Of  Integers  is:  ")  ; 

Int_IO. put (Outf ile,  RCDT. INTSIZE) ; 
new_line (Outf ile) ; 
for  I in  1. .RCDT.INT_SIZE  loop 
put (Out file,  "Integer  number  ") ; 

Int_IO.put (Outf ile,  1-1 , width  =>  5)  ; 
put(Outfile,  ":"); 

Temp_Addr  :=  Shmaddr  + system. offset( (1-1) *4) ; 

Int_IO. put (Outf ile,  RCDT. FINT(TempAddr) ) ; 
new_line (Outf ile) ; 
end  loop; 
end  Save_Ints; 

— Save  all  the  characters  from  RODB  Character  Component  to  a disk  file 
procedure  SaveChars (Outf ile  : in  FILETYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Characters  is:  "); 

Int_IO.put (Outf ile,  RCDT. CHARSIZE) ; 

new_line (Outf ile) ; 

for  I in  1. .RCDT.CHAR_SIZE  loop 

put(Outfile,  "Character  number  ")  ; 

Int_IO.put (Outf ile,  1-1,  width  =>  5)  ; 
put (Out file,  ":"); 

Temp_Addr  :=  Shmaddr  + system. of f set (RCDT. CHAR_OFFSET  + I— 1 ) ; 
put (Outf ile,  RCDT. FCHAR (Temp_Addr)  ) ; 
new_line (Outf ile) ; 
end  loop; 
end  Save_Chars; 

— Save  all  the  booleans  from  RODB  Boolean  Component  to  a disk  file 

procedure  Save_Bools (Outf ile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address ; 
begin 

put(Outfile,  "Number  Of  Booleans  is:  ")  ; 

Int_I0.put (Outf ile,  RCDT. BOOL_SIZE)  ; 
new_line (Outf ile)  ; 
for  I in  1. .RCDT.BOOL_SIZE  loop 
put(Outfile,  "Boolean  number  "); 

Int_IO.put (Outfile,  1-1,  width  =>  5)  ; 
put (Outf ile,  ":"); 

Temp_Addr  :=  Shmaddr  + system . of f set (RCDT. BOO L_OFFSET  + 1-1); 
Bool_IO.put (Outf ile,  RCDT . FBOOL (Temp_Addr) ) ; 
new_line (Outf ile) ; 


end  loop; 
end  Save_Bools ; 


Save  all  the  floats  from 
procedure  Save_Flts (Outf ile 
Temp_Addr  : system. address 
begin 


RODB  Float  Component 
: in  FILE_TYPE) 


to  a disk  file 
is 


put (Outf ile,  "Number  Of  Floats  is  "); 

Int_IO. put (Out file,  RCDT.FLT  SIZE); 
new_line (Outf ile) ; ~ 

for  I in  1. . RCDT. FLT_SIZE  loop 
put (Outf ile,  "Float  number  "); 

Int_I0. put (Outf ile,  1-1) ; 
put (Outf ile,  ":"); 

Temp_Addr  :=  Shmaddr  + system. offset (RCDT. FLT  OFFSET  + 
Flt_IO. put (Outf ile,  RCDT. FFLT (Temp  Addr) ) ; 
new_line (Outf ile) ; ~ 

end  loop ; 
end  Save_Flts; 


(1-1) *4) 


pragma  page; 


begin 

Shmid  :=  RCDT. SHMGET (RCDT. SHMKEY,  RCDT.SHM  SIZE 
if  Shmid  = -l  then  — ' 

raise  Shm_Exception; 
end  if; 

Shmaddr  :=  root. shmat( Shmid,  system. null  address, 
--  if  Shmaddr  = system. null_address  then- 
raise  ShmException; 

— end  if; 

Semid  :=  RCDT. SEMGET( RCDT. SEMKEY,  3.  10231* 
if  Semid  = -i  then  ' 

raise  Sem_Exception; 
end  if; 

end  Rodb_Component ; 


1023)  ; 
0)  ; 
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Job:  readbeg.c 

Date:  Tue  Apr  14  22:37:57  1992 


/include 

/include 

/include 


<sys/ types. h> 

<sys/ipc.h> 

<sys/sem.h> 


/*  The  operations  on  semaphores  */ 

struct  sembuf  RREAD_S TART  = { 0,  1,  0}; 
struct  sembuf  RWAIT_NO_WRITE_LOCK  = { i'  o'  Ob- 
struct sembuf  RWAIT_NO_WRITE_DESIRE  = { 2,  0,'  0>; 


int  readbeg (semid) 
int  semid; 

{ 

struct  sembuf  one_of_n_readers [ 3 ] ; 
int  flag; 
void  perror(); 


/*  Three  semaphore  operations  */ 


/*  Perform  three  semaphore  operations  */ 

one_of _n_readers [ 0 ] = RWAIT_NO_WRITE_LOCK;  /*  Wait  for  no  more  wri 

°ne_of_n_readers[l]  = RWAIT_NO_WRITE_DESIRE;  /*  Wait  for  no  more  wri 

one_of_n_readers ( 2 ] = RREAD_START;  /*  Prevent  writer  in  */ 

~ semoP(semid»  one_of _n_readers , 3);  /*  Lock  the  critical  sec 

if  (flag  = -l)  { 

per ror ("readbeg  fails:  ")  ; 

} 

return  flag; 
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Job:  readend.c 

Date:  Tue  Apr  14  22:37:58  1992 


/include 

/include 

/include 


<sys/ types. h> 
<sys/ipc.h> 
<sys/ sen. h> 


/*  The  operations  on  the  semaphore  */ 
struct  sembuf  RREAD_END  = { o,  -1,  0}; 

int  readend (semid) 
int  semid; 

{ 

int  flag; 
void  perror(); 

/*  Perform  the  semaphore  operation  */ 

ifa’fi4e«P-lWd'  ‘REEAD-END'  l,;  /*  Unlock  critical  section  ./ 

perror ("readend  fails:  ")  ; 

} 

return  flag; 
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Job:  writebeg.c 

Date:  Tue  Apr  14  22:38:20  1992 


/include  <sys/ types . h> 

/include  <sys/ipc.h> 

/include  <sys/sera.h> 

/*  The  operations  on  semaphores  */ 
struct  sembuf  WWA I T_N 0_READ ERS  = { 0,  0,  Ob- 
struct sembuf  WREAD_START  = { 0,  1,  Ob- 
struct sembuf  WWRITE_LOCK  = { 1,  1,  0>; 

struct  sembuf  WWRITE_DESIRE  = { 2,  1,  0>; 

struct  sembuf  WIN_PROGRESS_WRITE  = { 2,  -1,  0}; 

int  writebeg(semid) 
int  semid; 

{ 

struct  sembuf  sole_writer[4 ] ; /*  Four  semaphore  operations  */ 

int  flag; 
void  perror(); 

/*  Make  write  request  by  doing  a semaphore  operation  */ 
flag  = semop( semid,  &WWRITE_DESIRE,  1)  ; 
if  (flag  ==  -1)  { 

perror ("Write-Request  in  writebeg  fails:  ")  ; 
return  flag; 

} 

/*  Perform  four  semaphore  operations  */ 

sole_writer(0]  = WWAIT_NO_READERS ; /*  Wait  for  no  more  readers  * 

sole_writer ( 1 ] = WWRITE_LOCK;  /*  preventing  succeeding  read' 

sole_writer(2 ] = WREAD_START;  /*  preventing  succeeding  writ 

sole_writer[3]  = WIN_PROGRESS_WRITE;  /*  Cancel  the  write-request  * 

flag  = semop( semid,  sole_writer,  4);  /*  Lock  the  critical  section  * 

if  (flag  ==  -1)  { 

perror ("Wr ite_S tart  in  writebeg  fails:  ")  ; 

} 

pause ( ) ; 
return  flag; 
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Job:  writeend.c 

Date:  Tue  Apr  14  22:38:35  1992 


a a a a 


^include 
it  include 
^include 


<sys/ types. h> 

<sys/ipc.h> 

<sys/sem.h> 


/*  The  operations  on  semaphores  */ 
struct  sembuf  WREAD_END  = { 0,  -1,  0}; 

struct  sembuf  WWRITE_UNLOCK  = { 1,  -1,  0>; 

int  writeend (semid) 
int  semid; 

{ 

struct  sembuf  sole_writer[2] ; /*  Two  semaphore  operations  */ 

int  flag; 
void  perror(); 

/*  Perform  the  semaphore  operation  */ 

sole_writer [0]  = WREAD_END;  /*  Allow  writer  in  */ 

sole_writer[l]  = WWRITE_UNLOCK ; /*  Allow  reader  in  */ 

flag  = semop ( semid , solewriter,  2);  /*  Unlock  critical  section  */ 

if  (flag  ==  -1)  { 

perror ("writeend  fails:  ")  ; 

} 

return  flag; 


r rrr 

rr  r 

r 

r 

r 

r 


oooo 
o o 

o o 

o o 

o o 

oooo 


oooo 
o o 

o o 

o o 

o o 

oooo 


t 

t 

ttttt 

t 

t 

t 

t t 
tt 


i it 

t 


ssss 

eeee 

m 

m mm 

SSSS 

ii 

n 

nnn 

ii 

ttttt 

s 

e e 

jnm 

m 

TO 

s s 

i 

nn 

n 

i 

t 

ss 

eeeeee 

m 

TO 

TO 

ss 

i 

n 

n 

i 

t 

ss 

e 

m 

m 

TO 

ss 

i 

n 

n 

i 

t 

s 

e e 

m 

m 

TO 

s s 

i 

n 

n 

i 

t t 

ssss 

eeee 

m 

TO 

TO 

ssss 

iii 

n 

n 

iii 

tt 

Job:  sexnsinit.c 

Date:  Tue  Apr  14  22:38:55  1992 


^include  <sys/types . h> 

^include  <sys/ipc.h> 

^include  <sys/sem.h> 
int  semsinit (semid) 
int  semid; 

{ 

short  initarray [3 ] ; 
int  flag; 
void  perror(); 

initarray[0]  = initarray[l]  = initarray[2]  = 0 
flag  = seractl (semid,  3,  SETALL,  initarray); 
if  (flag  ==  -1)  { 

perror ( "semsinit  fails:  ")  ; 

} 

return (flag) ; 
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/include  <sys/types . h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semsrmv(semid) 
int  semid; 

{ 

int  flag; 
void  perror(); 

flag  = semctl (semid,  3,  IPC_RMID,  0) ; 
if  (flag  ==  -1)  { 

perror ("semsrmv  fails:  ") ; 

} 

return (flag) ; 
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The  RICIS  Concept 


The  University  of  Houston-Clear  Lake  established  the  Research  Institute  for 
Computing  and  Information  Systems  (RICIS)  in  1986  to  encourage  the  NASA 
Johnson  Space  Center  (JSC)  and  local  industiy  to  actively  support  research 
In  the  computing  and  Information  sciences.  As  part  of  this  endeavor,  UHCL 
proposed  a partnership  with  JSC  to  jointly  define  and  manage  an  integrated 
program  of  research  in  advanced  data  processing  technology  needed  for  JSC’s 
main  missions,  including  administrative,  engineering  and  science  responsi- 
bilities. JSC  agreed  and  entered  into  a continuing  cooperative  agreement 
with  UHCL  beginning  in  May  1986,  to  jointly  plan  and  execute  such  research 
through  RICIS.  Additionally,  under  Cooperative  Agreement  NCC  9-16, 
computing  and  educational  facilities  are  shared  by  the  two  institutions  to 
conduct  the  research. 

The  UHCL/RICIS  mission  is  to  conduct,  coordinate,  and  disseminate  research 
and  professional  level  education  in  computing  and  information  systems  to 
serve  the  needs  of  the  government,  industry,  community  and  academia. 
RICIS  combines  resources  of  UHCL  and  its  gateway  affiliates  to  research  and 
develop  materials,  prototypes  and  publications  on  topics  of  mutual  interest 
to  its  sponsors  and  researchers.  Within  UHCL,  the  mission  is  being 
implemented  through  interdisciplinary  Involvement  of  faculty  and  students 
from  each  of  the  four  schools:  Business  and  Public  Administration,  Educa- 
tion, Human  Sciences  and  Humanities,  and  Natural  and  Applied  Sciences. 
RICIS  also  collaborates  with  industry  in  a companion  program.  This  program 
is  focused  on  serving  the  research  and  advanced  development  needs  of 
industry. 

Moreover,  UHCL  established  relationships  with  other  universities  and  re- 
search organizations,  having  common  research  interests,  to  provide  addi- 
tional sources  of  expertise  to  conduct  needed  research.  For  example,  UHCL 
has  entered  into  a special  partnership  with  Texas  A&M  University  to  help 
oversee  RICIS  research  anl  education  programs,  while  other  research 
organizations  are  involved  via  the  “gateway*  concept 

A major  role  of  RICIS  then  is  to  find  the  best  match  of  sponsors,  researchers 
and  research  objectives  to  advance  knowledge  in  the  computing  and  informa- 
tion sciences.  RICIS,  working  jointly  with  its  sponsors,  advises  on  research 
needs,  recommends  principals  for  conducting  the  research,  provides  tech- 
nical and  administrative  support  to  coordinate  the  research  and  integrates 
technical  results  into  the  goals  of  UHCL,  NASA/JSC  and  industry. 
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APPENDICES  A & B 


Appendix  A 


Ada  Preprocessor 


Preprocessor  Version  0.5 


--  Changes  from  version  0.4 

User  enters  input  and  output  filenames. 

Ignores  comments  better  (hopefully  completely) 

List_pack  doesn't  allocate  storage  until  actually  needed. 


Assumptions/ limitations : 

1.  Input  and  Output  must  be  different  files. 

2.  Correct  Syntax.  ( input. ada  must  be  a compilable  Ada  program) 

3.  Flat  name  space  in  input. ada 

4.  The  read_open  calls  and  all  of  its  associated  attribute_read  calls 

--  are  in  input. ada. 

— 5.  The  specification  and  body  of  read open  and  attribute  read  are 

given  in  another  routine  (ie:  'with'ed  from  a package) 

6.  Each  read_open  will  use  a distinct  handle. 

7.  Each  attribute_read  uses  only  one  handle  (not  a list). 

8.  The  handle  in  an  attribute__read  is  the  exact  name  given  in 

--  corresponding  read__open. 

9.  The  syntax  of  the  read_open  and  attribute_read  is  just  like 

that  in  the  CDR  document.  (except  no  list  of  handles). 

10.  This  routine  produces  new  Ada  code,  which  must  then  be  seperately 

— compiled. 

11.  package  'dummy_pack'  is  created.  (decreased  name  space) 

12.  A MODB  routine  is  simulated  in  the  preprocessor  - when 
given  the  name  of  an  attribute,  returns  the  type  of  that 
attribute. 

13.  The  first  begin  in  the  file  is  the  begin  of  the  main  program. 

This  was  necessary  since  the  best  place  to  put  dummy  pack  just  before 
it.  (there  are  ways  around  this  - as  well  as  several  of  the  above) 


This  is  the  simulated  MODB  package  and  function  call 


| package  MODB_package  is 

function  Get_type  (What  : in  String)  return  String; 

! end  MODB_j?ackage; 


package  body  MODB_package  is 


— when  passed  an  attribute  name,  return  the  corresponding  type 

function  Get_type  (What  : in  String)  return  String  is 
begin 

if  (What  - "AP_TELESCOPE.X_POSITION")  then 
return  "X_POSITION  T"; 

elsif  (What  - "AP_TELf:SCOPE.Y  POSITION")  then 
return  "Y_POSITION  T"; 
elsif  (What  - "APJTELlISCOPE . SHUTTER")  then 
return  "SHUTTER_POSITION_T" ; 
elsif  (What  - "AP_TELESCOPE . RIGHT  ASC")  then 
return  "RIGHT_ASCENSION_T" ; 
elsif  (What  - "APJTELESCOPE . DECLINATION" ) then 
return  "DECLINATION  T"; 

elsif  (What  - "AP_TELE3C0PE . DEC  DEGREES")  then 
return  "DECLINATION_DEGREES_T" ; 
elsif  (What  - "AP_TELESCOPE.DEC  MINUTES")  then 
return  "DECLINATION_MINUTES_T" ; 
elsif  (What  - "AP_TELESCOPE . DEC  SECONDS")  then 
return  "DECLINATION  SECONDS  T"; 
elsif  (What  - " AP_TELE5COPE . STATE " ) then 
return  "STATE  T"; 
else  — 

return  "Unknown^type" ; 
end  if; 
end  Get_type; 
end  MODB_package ; 


— package  LIST_PACK 

This  is  a generic  list  package  that  must  be  instantiated  with 

— A data  type. 

--  Unconstrained  array  type  'list  type'  is  made  available  as  a 
private  type.  The  'wither'  sKould  create  a list  of  this 
type  and  pass  it  back  as  a parameter  to  the  calls  in  this 
package.  It  was  done  this  way  so  that  several  lists  can  be  worked  on 
~ ky  each  instantiation,  while  still  keeping  the  workings  of  the 
lists  private. 


with  Text_io;  use  Text_io; 
Generic 

type  Item_type  is  private; 
package  List_pack  is 


- This  is  the  type  that  is  used  by  'wither'  to  create  a list. 

type  List__type  (Max:  Natural)  is  private; 

function  Size^of (Lister  : in  List_type)  return  Integer; 

function  Get  item (Offset  : Integer;  Lister  : in  List  type)  return  Item  type 
procedure  Add_item (Item : in  Item_type;  Lister  : in  out  List  type) • 
procedure  Update_item ( Item : in  Item^type;  Lister  : in  out  List  type; 

Offset  : Natural); 


private 

type  Item_pt retype  is  access  Item_type; 


type  List_array  is  array ( Integer  range  <>)  OF  Item_ptr_type; 
type  List__type  (Max : Natural  ) is 
record 

List  : List_array (0 . . Max) ; 

Num__in  : Integer  : — 0; 

end  record; 

end  List_pack; 


Body 

package  BODY  List_pack  is 


--  Add  to  the  list 

procedure  Add__item ( Item : in  Item_type;  Lister  : in  out  List_type)  is 

begin 

if  Lister .Num_in  - Lister. Max  then 

Put("  ERROR:  List_pack . Add_item : Lister  of  items  is  full  - didn't  add”) 
else 

Lister .List (Lister .Num_in)  new  Item_type' (item) ; 

Lister .Num_in  :«  Lister  .Num__in  + 1; 
end  if; 
end  Add  item; 


--  Update  an  Item 

procedure  Update  item (Item:  in  Item type;  Lister  : in  out  List type; 

’ Offset  : Natural)  is 

begin 

if  Lister . Num_in  < Offset  then 

Put("  ERROR:  List_pack . Update_item:  offset  out  of  current  range"); 
else 

Lister .List (Offset  - l).all  : - Item; 

- 'end  if; 

end  Update_item; 


— Return  (without)  deleting,  the  item  at  a particular  offset 

function  Get_item (Of f set  : Integer;  Lister  : in  List_type)  return  Item_type  i 

begin 

if  Lister . Num_in  = 0 then 

Put ( " ERROR : List__pack . Get  item:  Lister  of  items  is  empty-  can't  retrieve") 
elsif  Offset  > Lister. Num  Tn  then 

Put(”  ERROR:  List j>ack ,^et_item:  not  that  many  items  - can't  retrieve"); 
else 

return  Lister . List (Of f set  - 1) .all; 
end  if; 
end  Get  item; 


--  Returns  how  many  items  are  currently  in  the  list 

function  Size_of (Lister : in  List_type)  return  Integer  is 

begin 

return  Lister . Num_in; 
end; 

end  List^pack; 


package  inout_pack 

This  is  a package  to  handle  all  reading  from  the  input  file  and 
writing  to  the  output  file 

--  Upon  instant iation,  the  input  and  output  files  are  opened 
Right  now,  they  are  static  filenames 


with  Text_io;  use  Text_io; 
package  Inout_pack  is 


— Supply  types  and  max  lengths  for  the  'words'  returned  each 
call  to  get_word 

Max_name__len  : constant  80; 

subtype  Name_len_type  is  Integer  range  O..Max  name  len; 
subtype  Name_type  is  String ( 1 . .Max_name  len);-  - 


Declare  a word  type  to  be  a name  type  and  a current  length 
Didn't  make  it  private  because  o7  the  plethora  of  times 
the  individual  fields  are  used  elsewhere. 

type  Word_type  is 
record 

Name  : Name  type; 

Len  : Name_Ten_t ype ; 
end  record; 

function  Get_next  word  return  Word  type; 
procedure  Put_f  (What  : in  String) 7 
prpcedure  Put_line_f  (What  : in  String  : =■  "")  ; 
procedure  Reset  input; 

function  Open__f lies (inn^fname, out_f name  : string)  return  boolean; 
end  Inout_pack; 


package  BODY  Inout_jpack  is 

Innf  : File_type; 

Outf  : File_type; 

Lookahead  : Character  : - Ascii. nul;  --  next  character  in  the  input 


— resets  the  input  file  back  to  the  beginning  of  the  file 


procedure  Reset_input  is 
begin 

Reset ( Innf) ; 

Lookahead  :*■  Ascii. nul; 
end; 


Outputs  a string  to  the  output  file 


procedure  Put_f  (What  : in  String)  is 
begin 

Put ( Out  f , What ) ; 
end  Put  f; 


Outputs  a string  and  new_line  to  the  output  file 


procedure  Put_line_f  (What  : in  String  "")  is 

begin 

Put_line  (Out f,  What)  ; 
end  Put  line  f; 


Scans  the  input  file*  Returns  the  next  'word' . Entire  comments 

are  passed  back  as  words.  Blanks,  line  feeds,  etc.  are  passed 

— back  as  one  character  long  words. 

Passes  back  an  ascii. nul  and  length  of  0 on  end-of-file 
It  finds  a single  word  by  stopping  at  blanks,  etc.  This  stop 

— character  is  stored  in  the  internal  (to  body)  variable 

— Qa2.1ed  lookahead.  Lookahead  is  then  used  as  the  first  character 
--  on  the  next  call 


function  Get_next_word  return  Word_type  is 
Word  : Word_type; 

Char  : Character; 

Cnt  : Integer; 

The  following  to  upper  was  taken  out  of  the  Verdix  library 

type  convert  t is  array (character ) of  character; 
to  upper:  constant  convert_t  :-  ( 

” ascii. nul,  ascii. soh,  ascii. stx,  ascii. etx, 

ascii. eot,  ascii. enq,  ascii. ack,  ascii. bel, 
ascii. bs,  ascii. ht,  ascii. If,  ascii. vt, 

ascii. ff,  ascii. cr,  ascii. so,  ascii. si, 
ascii. die,  ascii. del,  ascii. dc2,  ascii. dc3, 
ascii. dc4,  ascii. nak,  ascii. syn,  ascii. etb, 
ascii. can,  ascii. em,  ascii. sub,  ascii. esc, 
ascii. fs,  ascii. gs,  ascii. rs,  ascii. us. 


Gets  the  next  character 


function  Get_char  return  Character  is 
Temp_char  : Character; 
begin 

if  End_of__f  ile  (Innf ) then 
return  Ascii. nul; 
elsif  End  of_line ( Innf ) then 
Skip_lTne ( Innf ) ; 
return  Ascii. If; 
else 

Get ( Innf, Temp_char)  ; 
return  to_upper (Temp_char) ; 
end  if; 
end  Get_char; 

begin 

if  (End  of  f ile (Innf ) ) AND  (Lookahead  - Ascii. nul)  then 
WordTLen  0; 


Ascii . nul ; 


Lookahead  : « 
else 

if  Lookahead  - Ascii. nul  then 
Word. Name (1)  :«  Get_char; 

else 

Word. Name (1)  Lookahead; 
end  i f ; 

Word.Len  :«  1; 


Found  the  start  of  a word,  get  rest  of  word 

if  (Lookahead  in  'A'  ..  'Z')  then 

loop 

Char  Get  char; 

exit  when  (Uhar  not  in  fA'..'Z')  AND 

(Char  not  in  '1'..'9')  AND  (Char  /«  ' 
Word.Len  Word.Len  +1;  ” 

Word. Name  (Word.Len)  : =»  Char; 
end  loop; 

Lookahead  :»  Char; 


Look  to  see  if  it  is  a comment,  if  so  get  entire  comment 
To  do  this,  have  to  read  next  character.  if  it  is  not 
a minus,  pass  the  first  back  this  time  as  word(l)  and 
store  the  second  in  Lookahead 

elsif  (Lookahead  - then 

Char  Get  char; 
if  (Char  - 7"-')  then 
Word.Len  :«  2; 

Word. Name (Word.Len)  Char; 

9re^  1 i ( Innf , Word . Name  ( 3 . . Word . Name'  last ) , Cnt ) ; 
Word.Len  :«  Cnt; 

Lookahead  : - Ascii. If; 
else 

Lookahead  Char; 
end  i f ; 


else  just  pass  that  one  character  back  as  word(l) 
next  character  to  the  lookahead 


and  get 


else 

Lookahead  :«  Get  char; 
end  if; 
end  if; 


return  Word; 
end  Get_next  word; 


function  Open_f iles (inn_f name, out  fname 
begin  “ 

Open  (Innf,  in_f ile,  inn_fnaime)  ; 

Create  (Out  f,  out_file,  out_f name)  ; 
return  true; 
exception 

when  others  =>  return  false; 
end; 

end  Inout_pack; 


string)  return  boolean  is 


procedure  PROCESS 

This  is  the  main  preprocessor  routine 


with  Text  io;  use  Text_io; 
with  Listjack; 

with  Inout^pack;  use  Inout_pack; 


with  MODB_Package; 
procedure  Preprocess  is 


Generic  list  package 

Package  to  handle  all  I/O 

includes  definitions  for  Words,  etc. 

'Used'  it  because  it  is  used  so  often 


These  set  upper  bounds  on  the  number  of  read_opens,  attribute_reads 
and  the  number  of  components  in  an  attribute  or  address  array 

Max_num_opens  : constant  Integer  20; 

Max_num__reads  : constant  Integer  100; 

Max_items  : constant  Integer  20; 

Dummy_pack_name  : constant  String  : =*  "dummy^pack" ; 


Set  up  a list  of  Words  so  that  it  can  be  used  to  hold  the  parameters 
to  the  read__opens  and  attribute  reads 

package  Word_pack  is  NEW  List_pack (Word_type) ; 


Set  up  a list  of  read^open (s) , each  of  which  has  a Handle  name, 
attribute  list  name,  and  a list  to  store  the  actual  fields  in 
the  attibute  list  - filled  in  on  second  pass 

Type  Open_type  is  record 

Handle  : Word  type  :»  ((others  =>  ' '),0); 

Ary_id  : Word  type  : * ((others  ~>  ' '),0); 

Ary  : Wo rd_jpack . Lis t_type  (Max__i terns ) ; 
end  record; 

package  Open_pack  is  NEW  List_pack (Open_type) ; 

Open__list  : Open_pack . List_type  (Max_num_opens ) / 


Set  up  a list  of  attribute^read ( s) , each  of  which  has  an 
address  list  name  and  a list  to  store  the  actual  fields  in 
the  address  list  - filled  in  on  second  pass 

Type  Read_type  is  record 

Ary_id  : Word_type  : - ( (others  =*>  ' ' ) ,0)  ; 

Ary  : Word_pack  . List_type  (Max_items)  ; 
end  record; 

package  Read_pack  is  NEW  List_pack (Read_type) ; 

Read__list  : Read_pack . List_type (Max_num_reads ) ; 


--  Search  through  the  list  of  attribute_reads  for  an  address  parameter 
--  that  is  equal  to  Word.  Return  its  Index  if  found,  zero  otherwise 


function  Srch__read_Ary__id (Word  : Word_type)  return  Integer  is 
Temp_read  : Read_type; 
begin 

FOR  Index  in  1 . . Read_j?ack . Size^of (Read_list ) loop 


Temp_read  Re ad_j?ack  . Get_i tern  ( Index,  Read_list) / 

if  (Temp_read.Ary__id.Len  - Word.Len) 

and  (Temp  read .Ary_id. Name ( 1 . .Word.Len) 

- Wor3. Name ( 1 .. Word . Len) ) then 
return  Index; 
end  if; 
end  loop; 
return  0; 
end; 


--  Search  through  the  list  of  read  opens  for  an  attribute  parameter 
--  that  is  equal  to  Word.  Return  Tts  Index  if  found,  zero  otherwise 


function  Srch_open_Ary_id(Word: Word_type)  return  Integer  is 
Temp_open  : Open_type; 
begin 

FOR  Index  in  1 . . Open _p&ck . Size_of (Open_list ) loop 
Temp_open  Open_pack . Get_item ( Index, Open_list ) ; 

if  (Temp_open . Ary_id . Len  — Word.Len) 

and  (Temp  open ,Ary_id. Name ( 1 . .Word.Len) 

* WorcL Name (1. .Word.Len) ) then 
return  Index; 
end  if; 
end  loop; 
return  0; 
end; 


— Search  through  the  list  of  read  opens  for  a Handle  parameter 

— that  is  equal  to  Word.  Return  Tts  Index  if  found,  zero  otherwise 


function  Srch_open_Handle (Word: Word_type)  return  Integer  is 
Temp_open  : Open_type; 
begin 

FOR  Index  in  1 . . Open_pack . Size_of (Open_list ) loop 
Temp_open  Open  pack . Get_item ( Index, Open_list ) ; 
if  (Temp_open . HanHle . Len  - Word.Len) 

and  (Temp  open . Handle . Name ( 1 .. Word. Len) 

- Wor3. Name (1 . .Word. Len) ) then 
return  Index; 
end  if; 
end  loop; 
return  0; 
end; 


--  Outputs  the  complete  dummy  package  with  procedures  for  each  valid 
Handle  along  with  the  appropriate  formal  parameters 


procedure  Write_package  is 
Pararo_name  : String (1 .. 1 ) ; 
T_open  : Open_type; 

T_read  : Read_type; 

T_word  : Word_type; 
begin 


output  the  package  specification 

For  each  read_open,  output  a procedure  spec  for  it  using  the 
Handle  as  the  name  of  the  procedure  along  with  an  extension 
include  appropriate  parameters  for  each  field  in  its 
attribute  list,  starting  with  'a'  - name  doesn't  matter 


Put  line  f("--  THis  is  A DUMMY  package  ADDED  BY  THE  PREPROCESSOR  — "); 
Put-line— f ("package  " & Dummy_j)ack_name  & " is")  ; 

FOR  i in  1 . . Open^pack  . S ize__of  (Open^l  ist ) loop 
T open  : — Open_jpack  * Get__item  ( i , Open_list ) ; 

T— word  : **  T open.  Handle; 

Put  line  f(ir  procedure  " & T_word. Name  ( 1 . . T_word.  Len)  & 

""  ~~  "_dummy  ("); 

Paraxn  name  "a"; 

T wor3  :*  Word_j?ack . Get_item ( 1 , T open. Ary); 

Put  f("  " & Param__name  & w : " & 

T_word . Name ( 1 . . T_word . Len ) ) ; 

FOR  k in  2 . . Word_j>ack . Size_of  (T_open . Ary)  loop 

Param  name(l)  :*  character' succ (par am^name ( 1) ) ; 

Put_lTne_f  ( " ; " ) ; 

T_word  :«  Word_pack  . Get_item  < k,  T open. Ary); 

Put  f("  " & Param_name  & w : " & 

“ T^word . Name ( 1 . . T_word . Len ) ) 

end  loop; 

Put_line_f (") ;")  ; 
end  loop; 

Put  line_f("end  " & Dummy^pack_name  & ";"); 


Output  the  Package  body 

For  each  read_open,  output  a Procedure  body  for  it  using  the 
Handle  as  the- name  of  the  procedure  along  with  an  extension 
include  appropriate  parameters  for  each  field  in  its 
attribute  list,  starting  with  'a'  - name  doesn't  matter 
only  Statement  in  body  should  be  null 

Put  line_f ("package  body  " & Dummy_pack  name  & " is"); 

FOR- i in- 1 . . Open  _j>ack  . Size_of  (Open__listT  loop 
T_open  Open_pack . Get_item ( i,  Open_list ) ; 

T— word  T open. Handle; 

Put  line  f (w  procedure  " & T^word . Name ( 1 .. T_word. Len)  & 

— — "__dummy  ("  ) 

Param_jname  : * "a"; 

T word  :»  Word_jpack . Get_item  ( 1 , T open.  Ary); 

Put  f("  " & Param^name  & w : " & 

“ T_word. Name ( 1 .. T_word. Len) ) ; 

FOR  k in  2 . . Word pack . Size_of (T_open . Ary)  loop 

Param  name(l)  :*  character' succ (param_name ( 1) ) ; 

Put_lTne_f  ( " ; " ) ; 

T word  : - Wordjpack  . Get_item  (k,  T open. Ary); 

Put  f("  " & Param_name  & w & 

T_wo  rd . Name ( 1 . . T_word . Len ) ) ; 

end  loop; 

Put_line__f  ( " ) is  ” ) ; 

Put_line_f ( " begin" ) ; 

Put_line_f ("  null; ") ; 

Put_l  ine_f  ( " end;  " ) ; 

end  loop; 

Put_JLine  f("end  " & Dummy_pack_name  & ";"); 

PutTline_f ; 
end; 


Outputs  a call  to  the  appropriate  dummy  procedure  from  the  read__opens 
uses  Handle  with  extension  as  the  procedure  name  and  includes 
— actual  paramters  for  each  of  the  fields  in  the  address  list 


procedure  Write^call (Handle  : in  Word_type; addr : in  Word__type)  is 
T_read  : Read- type; 

T_word  : Word_type; 

Index  : Integer; 


begin 

Put_line_f ; 

Put_f("  This  is  a call  to  the  dummy  procedure  in  dummv  ">  • 

Put_line_f  ("package " ) ; y ' ' 

line_t (Dummy pack name  & " . " & Handle . Name ( 1 . .handle. Len)  & 


Index  :«  Srch  read_Ary_id (addr ) ; 

Thread  :™  Rea5 _jpack  . Get_item  ( Index,  Read  list); 
T_word  Word_pack  . Get_item  ( 1,  T_read.  Ary)  ; 

Put_f("  " & T word. Named.  .T  word.Len)); 

FOR  i in  2 . . Word  paclc  . Size  of  (T  react.  Ary)  loop 
Put_line_f  ; 

T__word  :«  Word_pack . Get_item (i , T_read . Ary ) ; 
Put_f("  " & T_word. Name ( 1. .T_word. Len) ) ; 

end  loop; 

Put_line_f (") ; ” ) ; 
end; 


n_dummy 


<") 


Scan  the  input  for  attribute_read  and  read  open 
Get  the  names  of  the  attribute  and  address- arrays 

procedure  Pass_one  (Open_list  : in  out  Open__pack . List  type; 

Read_list  : in  out  Readjpack . List- type)  is 

Word  : Word_type  :»  ((others  »>  ' f)f0); 

T_open  : Open_type; 

T_read  : Read_type; 

State:  Integer  range  0..4  0; 

begin 

loop 

Word  Get_next_word; 
exit  when  Word.Len  - 0; 
if  (Word.Name(l)  /»  ' ' ) and 

(Word . Name ( 1 ) /-  Ascii. ht)  and 
(Word .Name ( 1 ) /-  Ascii. If)  and 
(not  ((Word. len  > 2)  and  then 

( (Word. Name (1)  - ' ) and  (Word. Name (2 ) - '-'))))  then 
case  State  is 
when  0 **> 

if  (Word. Name ( 1 .. Word. Len)  * "READ  OPEN")  then 
State  1;  — 

T_open . Ary  id  ((others  ->  ' '),0); 

T open . Han3le  ((others  *>  ' '),0); 

elsiT  (Word. Name (1 . .Word.Len)  - "ATTRIBUTE  READ”)  then 
State  3;  “ 

Thread.  Ary_id  :-  ((others  ->  ' f),0); 
end  Tf; 
when  1 -> 

if  (Word. Name  ( 1 ) /«  ',')  then 

T_open.Ary_id.Name(l . .Word.Len)  Word. Named.  .Word.Len)  ; 
T_open.Ary_id.Len  Word.Len; 
else 

State  2; 

end  if; 
when  2 =*> 

if  (Word. Name ( 1 ) /-  9 , ')  then 

T_open. Handle. Name (1 . .Word.Len)  :«  Word .Name ( 1 .. Word  Len)- 
T_open.  Handle.  Len  : =■  Word.Len; 
else 

if  Srch_open  Handle (Word)  = 0 then 

Open _pack .Sdd_i tern (T_open, Open  list); 
else  ~ 

^^t  line ("Error:  same  Handle  used  in  two  read  opens")  * 
end  if;  — 


State  : = 0; 
end  if; 
when  3 -> 

if  (Word. Name ( 1)  * ) then 

State  4; 
end  if; 
when  4 — > 

if  (Word. Name (1)  /*  then 

Thread. Ary_id. Name ( 1 . .Word.Len)  Word.Name(l. .Word.Len) 

Thread. Ary_id . Len  :*  Word.Len; 
else 

if  Srch_read_Ary_id (Word)  - 0 then 

Read^pack . Add_item  <T_read,  Read_JList ) ; 
end  if; 

State  : * 0; 
end  if; 
end  case; 
end  if; 
end  loop; 
end  Pass  one; 


Scan  the  input  for  the  delcarations  of  attribute  and  address  arrays 
Store  the  fields  in  corresponding  list 


procedure  Pass  two  (Open list  : in  out  Open pack. List type; 

Read~list  : in  out  Read__pack . List_type)  is 
Word  : Word_type  : - ((others  — > 9 ')f0); 

T_word  : Word  type  ((others  «>  ' '),0); 

Attr_type_worcI  : Word_type  ((others  «>  f ')/0); 

T_°Pen  : Open_type; 

T_read  : Read_type; 

Index  : Integer; 

State:  Integer  range  0..9  0; 

begin 

Reset_input ; 

State  : = 0; 
loop 

Word  : =*  Get_next__word; 
exit  when  Word.Len  * 0; 
if  (Word .Name ( 1)  /“  9 9 ) and 

( Word . Name  ( 1 ) /=*  Ascii. ht)  and 

( Word . Name ( 1 ) /=*  Ascii. If)  and 

(not  ((Word.len  > 2)  and  then 

( (Word. Name (1)  - and  (Word. Name (2 ) - '-'))))  then 

case  State  is 
when  0 ~> 

if  (Srch__open_Ary_id  (Word)  > 0)  then 
State  1; 

Index  Srch__open  Ary_id  (Word)  ; 

T open  :*  Open_pacTc  . get_i tern  ( Index,  Open_list)  ; 
elsiT  (Srch_read_Ary_id(Word)  > 0)  then 
State  6; 

Index  Srch  read_Ary_id (Word) ; 

T read  :®  Rea3_j>ack . get_i tern ( Index, Read_list) ; 
end  Tf; 
when  1 -> 

if  (Word. Name ( 1)  “ 9 :r  ) then 

State  2; 

elsif  (Word. Name  (1)  =“  ',')  then 
State  :*  0; 
end  if; 
when  2 => 

if  (Word. Name  (1)  * 9 (9  ) then 
State  :=*  3; 


end  if; 
when  3 »> 

if  (Word. Name (1)  - '(')  then 
State  :*  4; 

T^_word . Len  : - 0; 
end  Tf; 
when  4 «> 

if  (Word. Name ( 1)  - ',')  then 
T_word.  Name  (T_word.  Len+1 ) : =* 

T_word.Len  T_word.len  + 1; 
elsif  (Word. Name ( 1 ) /-  ')')  then 

T_word. Name (T_word. Len+1 . . T_word . Len+Word . Len) 

Word. Name ( 1 . .Word. Len) ; 
T_word.Len  T_word.Len  + Word. Len; 
else 

declare 

Attr_jtype  : constant  String 

MODB _j>ackage.Get_type(T_word.name(l. .T  word. len)); 
begin  ~ 

At  tr_type_word.  named.  .Attr_type'  length)  Attr  type; 

Attr_type_word. len  :«  At t retype' length;  * 

end; 

Word_jpack.Add_item(Attr_type_word,  T open.  Ary)  ; 

Open _j>ack .Update__item (T_open, Open  list, Index)  ; 

State  :*  5; 
end  if; 
when  5 -> 

if  (Word. Name (1)  - ' , ' ) then 
State  3; 

elsif  (Word. Name ( 1 ) * ')')  then 
State  0; 

end  if; 
when  6 *> 

if  (Word. Name  ( 1)  - ':')  then 
State  7; 

elsif  (Word. Name (1)  - then 

State  0; 

end  if; 
when  7 ~> 

if  (Word. Name  ( 1)  » '(')  then 
State  8; 

T^word.Len  0; 
end  if; 
when  8 -> 

if  (Word.  Name  ( 1 ) /-  ''')  then 

T_word. Name (T_word. Len  + 1 . . T_word . Len+Word . Len) 

Word . Name ( 1 . .Word. Len) ; 
T_word. Len  T_word.Len  + Word. Len; 
else 

Word_j?ack.Add_item(T_word,  Thread. Ary)  ; 

Read _j>ack . Update  item(T  read, Read  list, Index) ; 

State  9; 
end  if; 
when  9 -> 

if  (Word. Name ( 1 ) - then 

T_word.Len  :*  0; 

State  : = 8; 

elsif  (Word.  Name  ( 1 ) **  ')')  then 
State  :=  0; 
end  if; 

end  case; 
end  if; 
end  loop; 
end  Pass  two; 


Echo  the  input  to  the  output  along  with  the  dummy  package  and 
— dummy  procedure  calls 

procedure  Pass_three  (Open list  : in  out  Open_pack . List__type; 

~ Read_list  : in  out  Read_j?ack . List_type)  is 

Word  : Word__type  : - ((others  ->  ' ')r0); 

T_Handle  : Word_type  ((others  ~>  ' ')f0); 

T_addr  : Word_type  :*  ((others  *>  ' '),0); 

State:  Integer  range  0..5  0; 

begin 

Reset_input ; 
loop 

Word  : * Get_next_word; 
exit  when  Word.Len  * 0; 
case  State  is 
when  0 *■> 

if  (Word. Name  (1  . .Word.Len)  =*  "BEGIN”)  then 
Write_package; 

State  :«  1; 
end  if; 
when  1 *> 

if  ( Word. Name (1 , .Word.Len)  - " ATTRIBUTE_READ" ) then 
State  :«  2; 
end  if; 
when  2 — > 

if  (Word. Name (1)  /«  ',')  then 

T_Handle .Name ( 1 .. Word. Len)  : * Word. Name ( 1 . .Word. Len) ; 
T~Handle.Len  Word.Len; 
else 

State  3; 

end  if; 
when  3 => 

if  (Word. Name (1)  /*  ',')  then 

T addr . Name ( 1 .. Word. Len)  Word. Name  ( 1 ..  Word.  Len)  ; 

T_addr.Len  :«  Word.Len; 
else 

State  4; 

end  if; 
when  4 *> 

if  (Word. Name ( 1 ) - ';')  then 
State  5; 

end  if; 
when  5 => 

Write_call  (T^handle, T_addr ) ; 

State  : * 1; 
end  case; 

if  (word. name (1)  - ascii. If)  then 
Put__line_f ; 
else 

Put f (Word. Name (1 . .Word.Len) ) ; 

end  if; 
end  loop; 

Put  line  f;  — forces  a new_line  at  end  of  output  file 
end  Pass  three; 


Main  program 

It  works  in  three  main  passes: 

1.  Scans  the  input  and  find  each  occurrance  of  ' open_read'  and 
' read_open' . 

— For  each  f open  read' , adds  an  'open'  item  to  the  open_list 

and  stores  lihe  handle  and  name  of  the  attribute  array  in  that 


item. 

For  each  ' attribute_read' , adds  a 'read'  item  to  the  read  list 
and  stores  the  name  of  the  address  array  in  that  item.” 

2 . Scans  the  input  and  find  where  each  of  the  attribute  arrays 

and  address  arrays  are  declared. 

For  each  attribute  array  found,  update  that  item  in  the  open  list- 
For  each  component  in  the  declaration,  add  an  entry  in  the 

'ary'  part  of  the  open  item  that  contains  the  type  of  that 
component . 

For  each  address  array  found,  update  that  item  in  the  read  list: 
For  each  component  in  the  declaration,  add  an  entry  in  the 
'ary'  part  of  the  read  item  that  contains  the  name  of  the 
component  without  the  address  qualifier. 

3.  Just  before  the  begin  of  the  main  procedure,  output  a dummy 

package  that  contains  a procedure  for  each  of  the  handles 
in  the  open_list.  The  parameters  to  each  array  will  have 
dummy  names  but  will  be  of  the  types  obtained  in  the 
attribute  array. 

For  each  of  ' attr ibute_read' : immediately  after,  place  a call  to 
the  appropriate  dummy  procedure.  The  parameters  will  be  the 
components  found  in  the  address  array,  except  without  the 
address  qualifier. 


begin 


--  Open  input  and  Output  files 
declare 

inn^fname  : string (1.  . Max_name_len)  ; 
inn_size  : integer; 

out_fname  : string(l.  .Max  name  len)  ; 
out^size  : integer; 
begin 

loop 

put ("Enter  input  file  name  ->  "); 
get_line (inn_fname, inn_size) ; 

put ("Enter  output  file  name  (not  same  as  input)  ->  "); 

get__line  (out^_fname,  out_size)  ; 

exit  when  ( (inn_^size  /*  out__size)  or  else 

(Inn  f name (1 .. inn_size)  /-  out  fname(l..out  size))); 
Put__line ("Input  and  Output  must  be  different  files");  ~~ 
end  loop; 

if  Open__f iles ( inn_f name ( 1 . . inn_si ze) , out  f name (1.. out  size)) 
then  — ~ 

Pass_one(Open_list,Read_list) ; 

Pass_two  (Open_list,Read__list ) ; 

Pass_three  (Open_list,Read_list ) ; 
else 

put_line ("Error  opening  files"); 
end  if; 
end; 


end  Preprocess; 


Appendix  B 

I PC  Message  Queue  Performance 
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Job:  read. me 

Date:  Sat  Mar  28  21:21:56  1992 


This  directory  stores  all  the  files  to  simulate  the  IPC  MESSAGE  oufttf 
COMMUNICATION  between  processes.  Two  processes  are  created  with  one 
program  using  the  fork  system  call.  One  is  the  sender  (parent)  and  th<= 
other  is  the  receiver  (child).  The  sender  sends  a short  message  (reouest^ 
to  the  receiver  through  one  IPC  Message  Queue.  The  receiver  receives 
™ 56qUest  and  sends  a response  back  to  the  sender  through  another 
IPC  Message  Queue.  The  sender  receives  the  response  message  This 
terminates  one  IPC  communication.  TESTING  IS  DONE  FOR  THE  NUMBER  OF 
AND  RECEIVING  CYCLES  FROM  1000  to  5000  in  steps  of  1000  ThTround-trfn 
measured  results  are  in  file  rodbconpl . out  for  the  receiver  and  in  till 
rodbcomp2 . out  for  the  sender.  ixe 
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Job : rodb_test_data . ada 

Date:  Sat  Mar  28  21:30:25  1992 


with  TEXT_IO,  SYSTEM; 
use  TEXT_IO,  SYSTEM; 
package  RODB_Test  Data  is 


— Message  queue  system  call  interface 
function  MSGGET(KEY  : in  integer; 

FLAG  : in  integer)  return  integer; 

pragma  INTERFACE (C,  MSGGET) ; 


pragma  INTERFACE_NAME (MSGGET , 
function  MSGSND (MSQID  : in 

MSGP  : in 
MSGSZ  : in 
MSGFLG  : in 
pragma  INTERFACE (C,  MSGSND); 
pragma  INTERFACE_NAME (MSGSND , 
function  MSGRCV (MSQID  : in 

MSGP  ; in 
MSGSZ  : in 
MSGTYP  : in 
MSGFLG  : in 
pragma  INTERFACE (C,  MSGRCV); 
pragma  INTERFACE_NAME (MSGRCV, 
function  MSGCTL (MSQID  : in 

CMD  : in 
BUFF  : in 
pragma  INTERFACE (C,  MSGCTL); 
pragma  INTERFACE_NAME ( MSGCTL , 
end  RODBTestData ; 


"msgget") ; 
integer; 

SYSTEM. address; 
integer; 

integer)  return  integer; 

"msgsnd") ; 
integer; 

SYSTEM. address ; 
integer ; 
integer; 

integer)  return  integer; 

"msgrcv") ; 
integer; 
integer; 

SYSTEM. address)  return  integer 
"msgctl") ; 
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Job : rodb_test6 . ada 

Date:  Sat  Mar  28  21:48:39  1992 


ft  ft 


~7  This  is  the  Performace  test  for  IPC  message  queue 

with  TEXT_IO , CALENDAR,  SYSTEM,  RODB  Test  Data,  POSIX  UNSAFE  PROOFS 
use  TEXT_IO,  CALENDAR,  SYSTEM,  RODB  Test  Data,  POSIX~UNSAFE-PROCESS" 
with  POSIX_PROCESS_IDENTIFICATION,  POSIX  PROCESS  PRIMITIVES*-  ' 

use  POSIX_PROCESS_IDENTIFICATION,  POSIX  PROCESS  PRIMITIVES* 
procedure  RODB_Test6  is  _ ~ ' 


— Constant  definition 

MSGKEY1  : constant  integer  :=  99; 

MSGKEY2  : constant  integer  :=  100; 

MTEXT_SIZE  : constant  integer  :=  500; 

MSG_LEN  : constant  integer  :=  10;' 

— Data  type  definition 

type  MSGForm_Type  is  record 

MType  : integer; 

MText  : string ( 1 .. MTEXT_SIZE) ; 
end  record ; 


— Package  instantiation 

package  INT_IO  is  new  TEXT_IO . INTEGER  10 ( integer) • 
package  FIX_IO  is  new  TEXT_I0. FIXEDIO (duration) ; ' 


Variable  definition 
My_PlD 
My_Status 
Msgidl 
Msgid2 
Flag 

Number_Of_Times 
StartjTime 
FinishTime 
Outfile 
Sender_Msg 
Receiver_Msg 
My_Msg 
Your_Msg 
MyResponse 
Your_Response 


POSIX PROCESS IDENTIFICATION. process  id  * 

POSIX_PROCESS_PRlMITIVES. termination- status; 

integer;  - 

integer; 

integer; 

integer ; 

CALENDAR . t ime ; 

CALENDAR. time; 
f ile_type; 

MSGForm_Type ; 

MSGForm_Type ; 
string(l. . MSG_LEN ) 
string (1. . MSG_LEN ) 
string (1. .MSG_LEN) 
string(l. .MSG  LEN) 


— Exception  definition 
MsgException  : exception; 
begin 


Input  the  number  of  times  from  user 
put ("Enter  the  number  of  times:  ") ; 
INT_IO.get(Number_Of_Times) ; 


t^n?C  Message  Queues  (request  and  response  queues) 

if  Msgidl  = -i  then  - ' ; ' 

Put_line( "Error  in  MSGGET."); 
raise  Msg_Exception; 
end  if; 

Msgid2  :=  RODB_Test  Da ta. MSGGET (MSGKEY2 , 1023); 
if  Msgid2  = -l  then  - 

Put_line ( "Error  in  MSGGET."); 
raise  Msg_Exception; 
end  i f ; 


primitive 

primitive 


— Create  two  processes  (Sender  and  Receiver) 

My  PID  :=  POSIX_UNSAFE_PROCESS_PRIMITIVES. fork;  — fork  a receiver  child 
if  My_PID  = POSIX_PROCESS_IDENTIFICATION.NULL_PROCESS_ID  then  — Child 
Start_Time  : = CALENDARTclock; 
for  I in  1. .Number_Of_Times  loop 

Flag:  =RODB_Test_Data . MSGRCV (Msgidl , Receiver_Msg' address,  MSG_LEN , 1,  0)  ; 

if  Flag  = -1  then 

put_line(M Error  in  MSGRCV.”); 
raise  Msg_Exception; 
end  if; 

My_Msg ( 1 . . MSG_LEN ) : = Rece i ver_Msg . MText ( 1 . . MSGLEN ) ; 

My_Response ( 1 . .MSG_LEN)  :=  "Hello  guys"; 

Sender_Msg.MType  :=  1; 

Sender_Msg . MText ( 1 . . MSG_LEN ) : = My_Response ( 1 . . MSG_LEN ) ; 

Flag  :=  RODB_Test_Data.MSGSND(Msgid2,  SenderMsg' address,  MSGLEN,  0) ; 
if  Flag  = -1  then 

put_line(" Error  in  MSGSND. ") ; 
raise  Msg_Exception; 
end  if ; 
end  loop; 

Finish_Time  :=  CALENDAR. clock; 

Delay  20.0;  — Wait  for  parent  to  manipulate  the  message  queue 

— Output  the  result  to  a file 

create (Out file,  out_file,  "rodbcompl.out", 

form=>"world=>read,  owner=>read_write") ; 
put_line(Outf ile,  "Number_Of_Iterations  Times"); 

INT_IO. put (Out file,  Number_Of_Times) ; 

FIX_IO. put (Out file,  Finish_Time-Start_Time) ; 
new_line( Out file) ; 
close (Outf ile) ; 

POSIX_PROCESS_PRIMITIVES.exit_process;  — Child  Exits 

else  — Parent 

Start_Time  :=  CALENDAR. clock; 
for  I in  1. .Number_Of_Times  loop 

Your_Msg ( 1 . .MSG_LEN)  :=  "Hi  world!"; 

Sender_Msg . MType  :=  1; 

Sender_Msg . MText ( 1 . . MSG_LEN ) : = Y our  Msg ( 1 . . MSG_LEN ) ; 

Flag  :=  RODB_Test_Data. MSGSND (Msgidl,  Sender_Msg' address , MSGLEN , 0) ; 

if  Flag  = -1  then 

put_line( "Error  in  MSGSND."); 
raise  Msg_Exception; 
end  if ; 

Flag :=RODB_Test_Data. MSGRCV (Msgid2 , Receiver_Msg' address,  MSGLEN,  1,0); 
if  Flag  = -1  then 

put_line( "Error  in  MSGRCV."); 
raise  Msg_Exception; 
end  if; 

Your  Response ( 1. .MSG_LEN)  :=  Rece iver_Msg. MText (1 . .MSG_LEN) ; 
end  loop; 

Finish_Time  :=  CALENDAR. clock; 
end  if; 

POSIX_PROCESS_PRIMITIVES.wait_for_child(My_Status) ; 

— Output  the  result  to  a file 

create (Out file,  out_file,  "rodbcomp2 . out"  , 

form=>"world=>read,  owner=>read_wr ite" ) ; 


Put_1ine(°utf ile,  "Number  Of  Iterations 
INT_IO. put (Outf ile,  Number  Of  Times); 

FIX— *?*Pu*-(°utfile,  Finish  Time-Start  Time) 
newline (Outf ile) ; “ 

close (Outf ile) ; 


Times”) 


--  Remove  the  IPC  Message  Queues (request 
Flag  RODB_Test_Data.MSGCTL(Msgidl,  0, 
if  Flag  = -l  then 

put_line(” Error  in  MSGCTL. ” ) ; 
raise  Msg_Exception; 
end  if; 

Flag  :=  RODB_Test_Data . MSGCTL (Msgid2  0, 
if  Flag  = -i  then 

put_line( "Error  in  MSGCTL.”); 
raise  Msg_Exception; 
end  if ; 


and  response  queues) 
SYSTEM. NULL_ADDRESS) ; 


SYSTEM. NULL_ADDRESS) ; 


exception 

when  Msg_Exception  => 

put_line( "Program  terminates 
when  others  => 

Put_line( "Other  exception  in 
end  RODB_Test6 ; 


abnormally. ”) ; 
main  program."); 
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Job : rodbcompl . out 

Date:  Sat  Mar  28  21:31:31  1992 


Number_Of_Iterations  Times 
1000  1.29565 

Number_Of_lterations  Times 
2000  2.51501 

Number_Of_lterations  Times 
3000  3.75342 

Number_Of_lterations  Times 
4000  5.08582 

Number_Of_Iterations  Times 
5000  6.33374 
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Job : rodbcomp2 . out 

Date:  Sat  Mar  28  21:31:44  1992 


Number 

Number 

Number 

Number_ 

Number 


_Of_Iterations  Times 

1000  1.29565 

_Of_Iterations  Times 

2000  2.52454 

Of_lterations  Times 

'3000  3.75342 

Of_Iterations  Times 

4000  5.08582 

Of_Iterations  Times 

'5000  6.33374 


Copies  of  this  publication  have  been  deposited  with  the  Texas  State  Library  in 
compliance  with  the  State  Depository  Law. 


Data  Management  Systems 

(DMS) 

Complex  Data  Types  Study 

Appendices  Cl  - C5 


Prepared  for 

NASA/JSC  Data  Management  Systems 
for  Space  Station  Freedom  (SSF) 


Prepared  by  Co-Principal  Investigators: 

T.  F.  Leibfried  Jr.  Swami  Natarajan 

Sadegh  Davari  Wei  Zhao 

University  of  Houston-Clear  Lake  Texas  A&M  University 


Research  Associates: 


Libin  Wu 

University  of  Houston-Clear  Lake 


Gary  Smith 

Texas  A&  M University 


Research  Institute  for  Computing  and  Information  Systems 

University  of  Houston-Clear  Lake 


The  RICIS  Concept 


The  University  of  Houston-Clear  Lake  established  the  Research  Institute  for 
Computing  and  Information  Systems  (RICIS)  in  1986  to  encourage  the  NASA 
Johnson  Space  Center  (JSC)  and  local  industry  to  actively  support  research 
in  the  computing  and  information  sciences.  As  part  of  this  endeavor,  UHCL 
proposed  a partnership  with  JSC  to  jointly  define  and  manage  an  integrated 
program  of  research  in  advanced  data  processing  technology  needed  for  JSC’s 
main  missions,  including  administrative,  engineering  and  science  responsi- 
bilities. JSC  agreed  and  entered  into  a continuing  cooperative  agreement 
with  UHCL  beginning  in  May  1986,  to  jointly  plan  and  execute  such  research 
through  RICIS.  Additionally,  under  Cooperative  Agreement  NCC  9-16, 
computing  and  educational  facilities  are  shared  by  the  two  institutions  to 
conduct  the  research. 

The  UHCL/R1CIS  mission  is  to  conduct,  coordinate,  and  disseminate  research 
and  professional  level  education  in  computing  and  information  systems  to 
serve  the  needs  of  the  government,  industry,  community  and  academia. 
RICIS  combines  resources  of  UHCL  and  its  gateway  affiliates  to  research  and 
develop  materials,  prototypes  and  publications  on  topics  of  mutual  interest 
to  its  sponsors  and  researchers.  Within  UHCL,  the  mission  is  being 
implemented  through  Interdisciplinary  involvement  of  faculty  and  students 
from  each  of  the  four  schools:  Business  and  Public  Administration,  Educa- 
tion, Human  Sciences  and  Humanities,  and  Natural  and  Applied  Sciences. 
RICIS  also  collaborates  with  industry  in  a companion  program.  This  program 
is  focused  on  serving  the  research  and  advanced  development  needs  of 
Industry. 

Moreover,  UHCL  established  relationships  with  other  universities  and  re- 
search organizations,  having  common  research  interests,  to  provide  addi- 
tional sources  of  expertise  to  conduct  needed  research.  For  example,  UHCL 
has  entered  into  a special  partnership  with  Texas  A&M  University  to  help 
oversee  RICIS  research  and  education  programs,  while  other  research 
organizations  are  involved  via  the  “gateway"  concept. 

A major  role  of  RICIS  then  is  to  find  the  best  match  of  sponsors,  researchers 
and  research  objectives  to  advance  knowledge  in  the  computing  and  informa- 
tion sciences.  RICIS,  working  jointly  with  its  sponsors,  advises  on  research 
needs,  recommends  principals  for  conducting  the  research,  provides  tech- 
nical and  administrative  support  to  coordinate  the  research  and  integrates 
technical  results  into  the  goals  of  UHCL,  NASA/JSC  and  industry. 
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Appendix  C-l 


Uncontested  RODB  Reads 
and 

Uncontested  RODB  Writes 


All  Protection  Mechanisms  are  Enabled  as  Semaphore  Protection  and 
Disabling  of  Preemption  to  Guarantee  Atomic  Semaphore  Transitions  in 
Place. 


r rrr 

rr  r 

r 

r 

r 

r 


oooo 
o o 

o o 

o o 

o o 

oooo 


oooo 
o o 

o o 

o o 

o o 

oooo 


t 

t 

ttttt 

t 

t 

t 

t t 
tt 


d 

d 

d 


r rrr 

eeee 

aaaa 

ddd 

d 

m i 

n mm 

eeee 

rr  r 

e e 

a 

d 

dd 

mm 

m 

m 

e e 

r 

eeeeee 

aaaaa 

d 

d 

m 

m 

m 

eeeeee 

r 

e 

a a 

d 

d 

m 

m 

m 

e 

r 

e e 

a aa 

d 

dd 

• « 

m 

m 

m 

e e 

r 

eeee 

aaaa  a 

ddd 

d 

• • 

m 

m 

m 

eeee 

Job: 

Date 


read • me 

Mon  Mar  30  00:56:21  1992 


This  directory  stores  all  the  files  to  build  up  a RODB  "attribute”  components. 
The  protection  mechanism  is  that  locking  is  set  at  the  RODB  level.  During  the 
lock  setting,  there  is  a prevention  of  preemption  used  to  protect  the 
semaphore  test-and-lock  operation  to  insure  atomicity.  This  is  done  inside  a 
C function  by  using  the  fast_setprio  system  call.  There  is  only  one  set  of 
three  UNIX  semaphores  in  the  whole  system  but  a total  of  seven  array  operations 
on  these  three  semaphores.  Before  actual  READING,  a set  of  five  semaphore 
operations  are  imposed  upon  the  three  semaphores,  two  of  which  are  repeated. 

The  reason  for  the  five  (with  two  repeats)  is  to  simulate  what  might  have 
to  be  done  if  this  were  to  be  implemented  with  the  current  Lynx  OS 
(where  the  kernel  is  preemptable)  and  no  prevention  of  preemption  were  to  be 
done;  ( This  is  done  in  a later  test).  After  actually  reading  the  RODB  one 
semaphore  operation  is  imposed  on  the  semaphores.  Before  actual  WRITING 
there  are  two  levels  of  operations:  write  desire  and  write  lock.  For 
write  "desire"  only  one  semaphore  operation  is  imposed  on  the  semaphores  and  fo 
write  "lock"  an  array  of  four  semaphore  operations  are  imposed  on  the 
smaphores • After  actual  writing,  a set  of  two  semaphore  operations  are  imposed 
on  the  semaphores.  A TEST  IS  DONE  TO  MEASURE  HOW  LONG  IT  TAKES  FOR  1000  TO  1000' 
READS  AND  WRITES.  THE  RESULTS  ARE  IN  FILE  rodbcompl.dat  for  reads.  THE  RESULTS 
ARE  IN  FILE  rodbcomp2.dat  for  writes.  This  test  does  not  involve  contention 
since  the  reads  and  writes  are  done  in  separate  runs. 
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Job : rodbtst8 1 . ada 

Date:  Mon  Mar  30  00:48:25  1992 


““  This  is  the  reading  test  program,  (uncontested  reads) 

with  TEXT  XO , CALENDAR , SYSTEM,  RODB Component  Data  Types,  RODB  Component/ 

use  TEXT XO , CALENDAR,  SYSTEM,  RODB Component Data  Types,  RODB  Component* 

procedure  RodbtstSl  is  ~ - ~ ' 

— Constant  definitions 

ATTR_SIZE  : constant  integer  :=  200; 

RESULT_S I Z E : constant  integer  :=  10; 

— Data  type  definition 
type  Result_Type  is  record 

Loops  : integer ; 

Times  : duration; 
end  record; 


— Package  instantiation 

package  INT_IO  is  new  TEXT_IO. INTEGER_IO( integer ) ; 
package  FIX_IO  is  new  TEXT_IO. FIXED_IO (duration) ; 
package  RCDT  renames  RODB_Component_Data_Types ; 
package  RODBCP  renames  RODB_Component ; 


— Variable  definitions 


Length 

Number  Of_Times 

AddrList 

Attr_List 

Start_Time 

Finish_Time 

Results 

Outfile 


integer; 

integer; 

RCDT . Pos_List_Type ( 1 . . ATTR_SIZE) ; 
RCDT . Attr_List_Type ( 1 . . ATTR  SIZE) ; 
CALENDAR . time ; - 

CALENDAR. time; 

array ( 1. .RESULTSIZE)  of  Result  Type; 
f ile_type; 


begin 

RODBCP . Load_Comps ( "rodbcomp . dat " ) ; — load  the  test  RODB 
Length  1; 

Addr_List (1)  :«  0; 

Number  Of _Times  :*  1000;  — inner  loop  iterations  initialization 
for  I in  1. .RESULT_SIZE  loop 

StartJTime  :■  CALENDAR. clock;  --  get  the  start  time  for  inner  loop 
for  J in  1. .Number_Of_Times  loop 

RODBCP. Read_Attrs(Addr_List,  Length,  Attr  List);  — Read  RODB 
end  loop ; ” 

Finish_Time  CALENDAR. clock;  — record  the  end  time 

Results (I)  :»  (Number_Of_Times,  Finish_Time-Start  Time);  — store  data 
Number_Of_Times  :»  Number_Of_Times  + 1000; 
end  loop; 


— Output  the  result  to  a file  now  that  test  is  over 
create (Out file,  out_file,  Hrodbcompl.out", 

f orm*>nworld=>read,  owner*>read  write") ; 
put_line (Outfile,  " rodbcompl.dat  ") ; 

put_line (Outfile,  "Test  NO  NO  Of  Iterations  Times"); 
for  I in  1.. RESULT  SIZE  loop 

INT_I0.put (Outfile,  I,  width  =>  5); 

INT_IO. put (Outfile,  Results (I) .Loops) ; 

FIX_IO. put (Outfile,  Results (I) .Times) ; 
new_line (Outfile) ; 
end  loop; 
close (Outfile) ; 
exception 

when  others  =*> 


put_line(”Main  program  exception”) 


end  RodbtstSI; 
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Job : rodbcompl . out 

Date:  Mon  Mar  30  00:57:09  1992 


Test  HO  HO  Of  Iterations  Times 


1 

1000 

1.43866 

2 

2000 

2.90466 

3 

3000 

4.33374 

4 

4000 

5.80927 

5 

5000 

7.24799 

6 

6000 

8.71387 

7 

7000 

10.14307 

8 

8000 

11.62805 

9 

9000 

13.04773 

10 

10000 

14.53265 
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J ob : rodbt st82 . ada 

Date:  Mon  Mar  30  00:48:26  1992 


— This  is  the  writing  test  program,  uncontested  writes 

with  TEXT_IO , CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
use  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
procedure  Rodbtst82  is 

— Constant  definitions 

ATTR_SIZE  : constant  integer  :=  200; 

RESULT_S I Z E : constant  integer  :=  10; 

— Data  type  definition 
type  Result_Type  is  record 

Loops  : integer ; 

Times  : duration; 
end  record; 


— Package  instantiation 

package  INT_IO  is  new  TEXT_I0. INTEGER_IO( integer) ; 
package  FIX_IO  is  new  TEXT_I0. FIXED_IO (duration) ; 
package  RCDT  renames  RODB_Component_Data_Types ; 
package  RODBCP  renames  RODB_Component ; 


— Variable  definition 


Length 

Number  Of_Times 

Addr_List 

Attr_List 

Start_Time 

Finish_Time 

Results 

Outf ile 


integer; 

integer; 

RCDT . Pos_List_Type ( 1 . . ATTR_SIZE) ; 
RCDT.Attr_List_Type(l. .ATTR_SIZE) ; 
CALENDAR . t ime ; 

CALENDAR . t ime ; 

array (1. .RESULT_SIZE)  of  Result_Type; 
f i le  type ; 


begin 

RODBCP. Load_Comps( "rodbcomp.dat") ; — load  the  RODB  Components 
Length  :=  1; 

Addr_List ( 1 ) : * 0 ; 

Attr_List(l)  :=  (Type_ID  =>  0,  Int_Value  =>  200); 

Number  Of_Times  :=  1000; 
for  I In  1. .RESULT_SIZE  loop 

Start_Time  :=  CALENDAR. clock;  — log  the  beginning 
for  J in  1. .Number_Of_Times  loop 

RODBCP . Wr ite_Attrs ( Addr_List , Length,  Attr_List) ; — write 
end  loop; 

Finish_Time  CALENDAR. clock;  — log  the  end 
Results (I)  :*  (Number_Of_Times,  Finish_Time-Start_Time) ; 

Number_Of_Times  Number_Of_Times  + 1000; 
end  loop; 

— Output  the  result  to  a file  now  that  test  is  over 
create (Outf ile,  out_file,  "rodbcomp2.out", 

form*>"world=>read,  owner*>read_write" ) ; 
put_line (Outf ile,  " rodbcomp2 . out  ") ; 

put_line (Outf ile,  "Test  NO  NO_Of_Iterations  Times"); 
for  I in  1.. RESULT  SIZE  loop 

INT_IO. put (Outf lie,  I,  width  =>  5); 

INT_IO. put (Outf ile.  Results (I) .Loops) ; 

FIX_IO. put (Outf ile.  Results (I) .Times) ; 
new_line( Out file) ; 
end  loop; 
close (Outf ile) ; 
exception 


when  others  *> 

put_line("Main  program  exception") ; 


end  Rodbtst82; 
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Job : rodb_component_ . ada 

Date:  Mon  Mar  30  00:48:28  1992 


with  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
use  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
package  Rodb_Component  is 

— Package  renaming 

package  RCDT  renames  Rodb_Component_Data_Types ; 

— Exception  definition 
Shm_Exception  : exception; 

Shm_Outrange  : exception; 

Sem_Exception  : exception; 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs(Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer;  ~ 
Attr_List  : in  out  RCDT.Attr_List_Type) ; 

— Write  attributes  to  RODB  components 

procedure  Write_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  RCDT.Attr_List_Type) 

— Print  out  the  semaphore  values 

procedure  Print_Sems; 

— Load  RODB  components  from  a disk  file 

procedure  Load_Comps (Filename  : in  string); 

— Save  RODB  components  to  a disk  file 

procedure  Save_Comps (Filename  : in  string); 

— Shutdown  the  RODB  components 
procedure  Shutdown_Comps ; 


end  RODB_COMPONENT; 
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Job : rodbcomp2 . out 

Date:  Mon  Mar  30  00:48:24  1992 


rodbcomp2 . out 

Test  NO  NO  Of  Iterations  Times 


1 

1000 

1.73431 

2 

2000 

3.57086 

3 

3000 

5.30518 

4 

4000 

7.09534 

5 

5000 

8.88556 

6 

6000 

10.66620 

7 

7000 

12.40057 

8 

8000 

14.22754 

9 

9000 

15.92505 

10 

10000 

17.76160 
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Job : rodb_component_data_types_ . ada 

Date:  Mon  Mar  30  00:51:26  1992 


— This  package  provides  the  constants,  instantiated  packages,  system  calls 

— and  C functions  interfaces  to  C language  for  RODB  COMPONENT  package 

with  TEXT_IO,  SYSTEM; 

use  TEXT_IO , SYSTEM; 

package  RODB_COMPONENT_DATA_TYPES  is 

— Constants 

INT_SIZE  : constant  integer  : = 10; 

CHAR_SIZE  : constant  integer  :=  10; 

BOOL_SIZE  : constant  integer  :*  10; 

FLT_SIZE  : constant  integer  10; 

SHMKEY  : constant  integer  :»  99; 

SEMKEY  : constant  integer  :*  100; 

SHM_SIZE  : constant  integer  INT_SIZE*4+CHAR_SIZE+BOOL  SIZE+4*FLT  SIZE; 

CHAR_OFFSET  : constant  integer  :■  INT_SIZE*4;  ~ 

BOOL_OFFSET  : constant  integer  CHAR_OFFSET  + CHAR_SIZE*1; 

FLT_OFFSET  : constant  integer  : =•  BOOL_OFFSET  + BOOL_SIZE*l; 

— Data  types 

type  Attr_Type(Type_ID  s integer  0)  is  record 
case  Type_ID  is 
when  0 -> 

Int_Value  : integer; 
when  1 «> 

Char_Value  : character; 
when  2 ■> 

Bool_Value  : boolean; 
when  3 *> 

Flt_Value  : float; 
when  others  *> 
null; 
end  case; 
end  record; 

type  Attr_List_Type  is  array ( integer  range  <>)  of  Attr_Type; 
type  Pos_Li s t_Type  is  array ( integer  range  <>)  of  integer; 

' — Package  instantiation 

package  INT_IO  is  new  TEXT_IO. INTEGER_IO( integer) ; 
package  BOOL_IO  is  new  TEXT_IO. ENUMERATIONIO (boolean) ; 
package  FLT_IO  is  new  TEXT_IO.FLOAT_IO( float) ; 
function  FINT  is  new  system. fetch_from_address (integer) ; 
function  FCHAR  is  new  system. fetch_from_address (character) ; 
function  FBOOL  is  new  system. fetch_from_address (boolean) ; 
function  FFLT  is  new  system. fetch_from_address (float) ; 
procedure  AINT  is  new  system. assign_to_address( integer) ; 
procedure  ACHAR  is  new  system. assign_to_address (character) ; 
procedure  ABOOL  is  new  system. assign_to_address (boolean) ; 
procedure  AFLT  is  new  system. assign_to_address( float) ; 

— Shared  memory  system  call  interface 
function  SHMGET(KEY  : in  integer; 

SIZE  : in  integer; 

FLAG  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SHMGET) ; 
pragma  INTERFACE_NAME ( SHMGET , » shmge t " ) ; 
function  SHMAT ( SHMID  : in  integer; 

SHMADDR  : in  system. address; 

FLAG  : in  integer)  return  system. address; 
pragma  INTERFACE (C,  SHMAT); 
pragma  INTERFACE_NAME( SHMAT,  "shmat") ; 


function  SHMDT ( SHMADDR  : in  system. address)  return  integer 

pragma  INTERFACE (C,  SHMDT); 

pragma  INTERFACE_NAME ( SHMDT,  "shmdt"); 

function  SHMCTL ( SHMID  : in  integer; 

CMD  : in  integer; 

BUFF  : in  system. address)  return  integer 

pragma  INTERFACE (C,  SHMCTL); 
pragma  INTERFACE_NAME  ( SHMCTL , ” shmct  1 " ) ; 

— Semaphore  system  call  and  C function  interface 
function  SEMGET(KEY  : in  integer; 

NSEMS  : in  integer; 

FLAG  : in  integer)  return  integer; 

pragma  INTERFACE (C,  SEMGET) ; 
pragma  INTERFACE_NAME ( SEMGET , " semget M ) ; 
function  SEMSINIT(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMSINIT); 
pragma  INTERFACE_NAME( SEMSINIT,  "semsinit") ; 
function  SEMPRINT ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMPRINT); 
pragma  INTERFACE_NAME( SEMPRINT,  "semprint") ; 
function  READBEG ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READBEG); 
pragma  INTERFACE_NAME ( READBEG,  "readbeg") ; 
function  READEND( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READEND); 
pragma  INTERFACE_NAME (READEND,  "readend"); 
function  WRITEBEG ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEBEG); 
pragma  INTERFACE_NAME (WRITEBEG,  "writebeg") ; 
function  WRITEEND ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEEND); 
pragma  INTERFACE_NAME (WRITEEND,  "writeend") ; 
function  SEMSRMV( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMSRMV) ; 
pragma  I NT ERF AC E_N AM E (SEMSRMV , "semsrmv"); 

end  RODB_Component_Data_Types ; 
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Job : rodb_component_ . ada 

Date:  Mon  Mar  30  00:54:23  1992 


with  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
use  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
package  Rodb_Component  is 

— Package  renaming 

package  RCDT  renames  Rodb_Component_Data_Types ; 

— Exception  definition 
Shm_Exception  : exception; 

Shm_Outrange  : exception; 

Sem_Exception  : exception; 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  out  RCDT.Attr_List_Type) ; 

— Write  attributes  to  RODB  components 

procedure  Write_Attrs(Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  RCDT.Attr_List_Type) ; 

— Print  out  the  semaphore  values 

procedure  Print_Sems; 

— Load  RODB  components  from  a disk  file 

procedure  Load_Comps (Filename  : in  string); 

— Save  RODB  components  to  a disk  file 

procedure  Save_Comps (Filename  : in  string); 

— Shutdown  the  RODB  components 
procedure  Shutdown_Comps ; 


end  RODB  COMPONENT; 
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J ob : rodbcomponent . ada 

Date:  Mon  Mar  30  00:48:30  1992 


with  TEXT_IO,  CALENDAR,  SYSTEM,  PREEMPTION_CONTROL,  Rodb_Component_DataJTypes ; 
use  TEXT_IO,  CALENDAR,  SYSTEM,  PREEMPT I ON_CONTROL , Rodb_Component_Data_Types ; 
package  body  Rodb_Component  is 

— Local  variables 
Shmid  : integer ; 

Shmaddr  : system. address; 

Semid  : integer; 


— Local  subprograms 
procedure  Load_Ints (Infile 
procedure  Load_Char s (Infile 
procedure  Load_Bools (Inf ile 
procedure  Load_Flts( Infile 
procedure  Save_Ints (Out file 
procedure  Sa ve_Char  s ( Ou t f i 1 e 
procedure  Save_Bools (Outf ile 
procedure  Save_Flts (Outf ile 


in  FILE_TYPE) 
in  FILEJTYPE) 
in  FILEJTYPE) 
in  FILEJTYPE) 
in  FILEJTYPE) 
in  FILEJTYPE) 
in  FILEJTYPE) 
in  FILEJTYPE) 


— Read  attributes  from  RODB  components  simulating  array  of  handles  read 
procedure  Read_Attrs (Addr_List  : in  RCDT . Pos_List_Type ; 

Length  : in  integer; 

Attr_List  : in  out  RCDT.Attr_List_Type)  is 
Temp  : system. address; 

Flag  : integer; 
begin 

— PREEMPTION_CONTROL.DISABLE_PREEMPTION;  — more  efficient  in  C program 
Flag  : = RCDT. READBEG( Semid ) ; 

— PREEMPTION_CONTROL.ENABLE_PREEMPTION;  — in  C program 
if  Flag  * -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1 . . Length  loop 

if  (Addr_List (I)  < 0)  or  (AddrList (I)  > RCDT.SHM_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp  :=  Shmaddr  + system. offset (Addr_List (I) ) ; 
if  (Addr  List (I ) < RCDT. CHAR_OFFSET)  then 

Attr_Llst(I)  :=  (Type_ID  =>  0,  Int_Value  =>  RCDT. FINT( Temp) ) ; 
elsif  (Addr_List (I)  < RCDT . BOOL_OFFSET)  then 

Attr_List (I)  :=  (Type_ID  =>  1,  Char_Value  =>  RCDT. FCHAR( Temp) ) ; 
elsif  (Addr_List (I)  < RCDT . FLT_OFFSET)  then 

Attr_List (I)  (Type_ID  =>  2,  Bool_Value  ->  RCDT. FBOOL (Temp) ) ; 
else 

Attr_List(I)  (Type_ID  =>  3,  FltValue  =>  RCDT. FFLT( Temp) ) ; 
end  if; 
end  loop; 

— PREEMPTION_CONTROL.DISABLE_PREEMPTION;  — again  done  in  C program 
Flag  RCDT. READEND( Semid) ; — This  is  a C function 

— PREEMPTION_CONTROL . ENABLE_PREEMPTION ; 
if  Flag  - -1  then 

raise  Sem_Exception; 
end  if ; 

end  Read  Attrs; 


— Write  attributes  to  RODB  components  again  simulating  array  of  handles 

procedure  Write_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  RCDT.Attr_List_Type)  is 

Temp  : system. address; 


Flag  : Integer ; 
begin 

— PREEMPTION_CONTROL . DISABLE_PREEMPTION ; /*  In  C program  for  efficiency  */ 
Flag  RCDT.WRITEBEG(Semid) ; — also  a C function 

— PREEMPTION_CONTROL.ENABLE_PREEMPTION;  /*  Also  in  C */ 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1 . . Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr_List(l)  > RCDT. SHM_SIZE-l)  then 
raise  Shm_Outrange ; 
end  if; 

Temp  Shmaddr  + system. offset (Addr_List (I) ) ; 
if  (Addr_List(I)  < RCDT . CHAR_OFFSET)  then 
RCDT . AINT (Temp,  Attr_List (I) . lnt_Value) ; 
elsif  (Addr_List(I)  < RCDT . BOOL_OFFSET)  then 
RCDT . ACHAR (Temp , Attr_List (I) . Char_Value) ; 
elsif  (Addr_List (I)  < RCDT . FLT_OFFSET)  then 
RCDT. ABOOL( Temp,  Attr_List(I) .Bool_Value) ; 
else 

RCDT . AFLT ( Temp , Attr_List (I) . Flt_Value) ; 
end  if; 
end  loop; 

— PREEMPTION_CONTROL.DISABLE_PREEMPTION;  /*  In  C program  */ 

Flag  RCDT . WRITEEND ( Semid) ; —AC  function 

— PREEMPTION_CONTROL. ENABLE  PREEMPTION;  /*  In  C proqram  */ 
if  Flag  * -1  then 

raise  Sem_Exception; 
end  if; 

end  Write_Attrs; 

— Print  out  the  semaphore  values 
procedure  Print_Sems  is 
Flag  : integer ; 
begin 

Flag  RCDT. SEMPRINT( Semid) ; 

if  Flag  - -1  then 

raise  Sem_Exception; 
end  if; 

end  Print_Sems ; 

— Load  RODB  Components  from  a disk  file. 

— The  structure  of  disk  file  is  as  following: 

Number_Of_Integers 
Positionl  Integerl 
Position2  Integer 2 

• • • 

Number_Of_Characters 
Positionl  Characterl 

— Position2  Character2 
• • # 

Number_0 f_Boo leans 
Positionl  Booleanl 
Position2  Boolean2 

— Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 

*»<=*  • « « 

procedure  Load_Comps (Filename  : in  string)  is 


Infile  : FILE_TYPE; 

Temp  : system. address; 

Flag  : integer ; 
begin 

open (Infile,  in_file.  Filename) ; 

— Initialize  RODB  Integer  Component 
for  I in  1. .RCDT.INT_SIZE  loop 

Temp  :=  Shmaddr  + system. offset ( (1-1) *4) ; 

RCDT . AINT (Temp , 0 ) ; 
end  loop; 

Load_Ints( Infile) ; 

— Initialize  RODB  Character  Component 
for  I in  1. .RCDT.CHAR_SIZE  loop 

Temp  :=  Shmaddr  + system. offset (RCDT. CHAR_OFFSET  + 1-1) ; 
RCDT . ACHAR (Temp , ' X ' ) ; 
end  loop; 

Load_Chars (Inf ile) ; 

— Initialize  RODB  Boolean  Component 
for  I in  1. .RCDT.BOOL_SIZE  loop 

Temp  :=  Shmaddr  + system. offset (RCDT. BOOL_OFFSET  + 1-1) ; 
RCDT. ABOOL( Temp,  true) ; 
end  loop; 

Load_Bools (Infile) ; 

— Initialize  RODB  Float  Component 
for  I in  1. .RCDT. FLT_SIZE  loop 

Temp  :=  Shmaddr  + system. offset (RCDT. FLT_OFFSET  + (I-l)*4); 
RCDT. AFLT( Temp,  0.0); 
end  loop; 

Load_Flts (Infile) ; 
close (Inf ile) ; 

Flag  RCDT. SEMSINIT(Semid) ; 
if  Flag  * -1  then 
raise  Sem_Exception; 
end  if; 

exception 

when  name_error  => 

put_line("File  cannot  be  opened."); 
put_line( "Loading  components  fails!”); 
when  data_error  | end_error  => 

put_line("File  format  is  incompatible."); 
put_line( "Loading  components  fails!"); 
when  Sem_Exception  => 

put_line( "Semaphore  cannot  be  initialized."); 
raise  Sem_Exception; 
when  others  >> 

put_line( "Unknown  exception."); 
put_line( "Loading  components  fails!"); 
end  Load_Comps; 

— Save  RODB  Components  to  a disk  file 

— The  structure  of  the  disk  file  is  as  following: 

Number_Of_Integers 


— 

Positionl 

Integer 1 

— 

Position2 

Integer2 

— 

• • • 

Number_Of_ 

Characters 

— 

Positionl" 

Character 1 

— 

Position2 

Character2 

— 

• • • 

Number_Of_ 

Booleans 

— 

Positionl" 

Booleanl 

— — 

Position2 

Boolean2 

— — 

• • • 

Number_0f_ 

Floats 

-- 

Positionl" 

' Floatl 

— 

Position2 

Float2 

procedure  Save_Comps (Filename  : in  string)  is 
Outfile  : FILEJTYPE; 
begin 

if  Filename  /■  "”  then 

create (Outfile,  out_file,  Filename, 

form->"world->read,  owner=>read  write"); 

Save_Ints (Outfile) ; 

Save_Chars (Outfile) ; 

Save_Bools (Outfile) ; 

Save_Flts (Outfile) ; 
close (Outfile) ; 
else 

Save_Ints (TEXT_IO. standard_output) ; 

Save_Chars (TEXT_IO. standard_output) ; 

Save_Bools (TEXT_IO. standard_output) ; 

Save  Fits (TEXT  10. standard  output); 
end  if; 
exception 

when  constraint_error  »> 

put_line ( "RODB  Components  data  collapsed.”); 
put_line(" Saving  components  fails!”); 
when  others  -> 

put_l ine ( “Unknown  exception . " ) ; 
put_line(” Saving  components  fails!"); 
end  Save_Comps ; 

— Shutdown  ROOB  Components 
procedure  Shutdown_Comps  is 
Flag  : integer; 
begin 

Flag  :«  RCDT.SHMDT(Shmaddr) ; 
if  Flag  ■ -1  then 
raise  Shm_Exception; 
end  if; 

Flag  :■  RCDT. SHMCTL(Shmid,  0,  system. null  address); 
if  Flag  - -l  then 
raise  Shm_Exception; 
end  if; 

Flag  RCDT.SEMSRMV(Semid) ; 
if  Flag  - -1  then 
raise  Sem_Exception; 
end  if; 

end  Shutdown__Comps ; 


pragma  page; 


Load  all  the  integers  from  a disk  file  to  RODB  Integer  Component 

procedure  Load  Ints( Infile  : in  FILE_TYPE)  is 
Length  : Integer; 

Temp_Pos  : integer ; 

Temp_Int  : integer; 

Temp_Addr  : system. address; 
begin 

INT_IO. get (Infile,  Length); 

skip_line(Infile) ; 

for  I in  1 . . Length  loop 

INT_IO. get (Infile,  Temp_Pos) ; 

INT_IO. get (Infile,  Temp_Int) ; 
skip  line(Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.INT_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :=»  Shmaddr  + system. offset (Temp_Pos*4) ; 

RCDT . AINT ( Temp_Addr , Temp_I nt ) ; 
end  loop; 
end  Load_Ints; 

— Load  all  the  charaters  from  a disk  file  to  RODB  Character  Component 
procedure  Load  Chars (Infile  : in  FILE_TYPE)  is 

Length  : Integer; 

Temp_Pos  : integer; 

Temp_Char  : character; 

Temp_Addr  : system. address; 
begin 

INT_I0. get (Infile,  Length); 

skip  line(Infile) ; 

for  I in  1 . . Length  loop 

INT_I0. get (Infile,  Temp_Pos) ; 

get (Infile,  Temp_Char) ; --  Skip  a space 

get (Infile,  Temp_Char) ; 
skip  line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.CHAR_SIZE-1)  then 
raise  Shm_Outr ange ; 
end  if; 

Temp_Addr  Shmaddr  + system. of f set (RCDT. CHAR_OFFSET+Temp_Pos) ; 
RCDT.ACHAR(Temp_Addr,  Temp_Char) ; 
end  loop; 
end  Load_Chars; 

— Load  all  the  booleans  from  a disk  file  to  RODB  Boolean  Component 
procedure  Load  Bools (Infile  : in  FILE_TYPE)  is 

Length  : Integer; 

Temp_Pos  : integer ; 

Temp_Bool  : boolean; 

Temp_Addr  : system. address; 
begin 

INT_I0 . get ( Infile , Length) ; 

skip_line (Infile) ; 

for  I in  1 . . Length  loop 

INT_IO. get (Infile,  Temp_Pos) ; 

BOOL_IO. get (Infile,  Temp_Bool) ; 
skip_line( Infile) ; 

if  (Temp  Pos  < 0)  or  (Temp_Pos  > RCDT.BOOL_SIZE—l)  then 
raise  Shm_Outr ange ; 
end  if; 


Temp_Addr  :=  Shmaddr 
RCDT . ABOOL ( Temp_Addr , 
end  loop; 
end  Load_Bools; 


+ system. offset (RCDT. BOOL_OFFSET+Temp  Pos) 
Temp_Bool) ; ~ 


9 


— Load  all  the  floats  from  a disk  file  to  RODB  Float  Component 
procedure  Load  Fits (Infile  : in  FILE  TYPE)  is 
Length  : Tnteger;  — 

Temp_Pos  : integer ; 

Temp_Flt  : float; 

Temp_Addr  : system. address; 
begin 

INT_IO.get (Inf ile,  Length) ; 

skip_line (Infile) ; 

for  I in  1 . . Length  loop 

INT_IO . get ( Inf i le , Temp_Pos ) ; 

FLT_IO . get ( Infile , Temp_Flt) ; 
skip_line ( Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.FLT  SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  Shmaddr  + system. offset (RCDT.FLT  OFFSET+Temp  Pos*4) • 
RCDT . AFLT ( Temp_Addr , Temp_Flt) ; ~ F-  ' ' 

end  loop; 
end  Load_Flts; 


pragma  page; 


~ Save  all  the  integers  from  RODB  Integer  Component  to  a disk  file 
procedure  Save_Ints (Out file  : in  FILE  TYPE)  is 
Temp_Addr  : system. address;  ™ 

begin 

put(Outfile,  "Number  Of  Integers  is:  "); 

Int_IO . put (Outf ile , RCDT. INT  SIZE) ; 
new_line(Outfile) ; “ 

for  I in  1. .RCDT.INT_SIZE  loop 
put (Outf ile,  "Integer  number  ") ; 

Intio. put (Outf ile,  1-1,  width  «>  5) ; 
put(Outfile,  ":"); 

Temp_Addr  :■  Shmaddr  + system. offset ( (1-1) *4) ; 

Int_IO. put (Outf ile,  RCDT. FINT( Temp  Addr) ) ; 
new_line (Outf ile) ; 
end  loop; 
end  Save  Ints; 


®aYe  characters  from  RODB  Character  Component  to  a disk  file 

procedure  Save_Chars (Out file  : in  FILE  TYPE)  is 
Temp_Addr  : system. address;  ~ 

begin 

put (Out file,  "Number  Of  Characters  is:  ") ; 

IntjEO. put (Outf ile,  RCDT. CHAR  SIZE) ; 
new_line (Outf ile) ; ~ 


for  I in  1. .RCDT.CHAR_SIZE  loop 
put (Outf ile,  "Character  number  "); 

Int_IO. put (Outf ile,  I-l,  width  =>  5) ; 
put(Outfile,  ":"); 

Temp_Addr  :■  Shmaddr  + system. off set (RCDT. CHAR  OFFSET  + I-l) • 
put (Outf ile,  RCDT. FCHAR (Temp  Addr) ) ; ~ 

new_l ine ( Outf ile);  “ 

end  loop; 


end  Save_Chars; 

— Save  all  the  booleans  from  RODB  Boolean  Component  to  a disk  file 

procedure  Save_Bools(Outfile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Booleans  is:  ") ; 

Int_IO. put (Out file,  RCDT. BOOL_SIZE) ; 
new_line(Outf ile) ; 
for  I in  1. .RCDT.BOOL_SIZE  loop 
put(Outfile,  "Boolean  number  "); 

Int_IO.put (Outf ile,  1-1,  width  =>  5) ; 
put(Outfile, 

Temp_Addr  Shmaddr  + system. offset (RCDT. BOOL_OFFSET  + 1-1) ; 
Bool_IO. put (Outf ile,  RCDT . FBOOL ( Temp_Addr ) ) ; 
new_line (Out file) ; 
end  loop; 
end  Save_Bools; 

— Save  all  the  floats  from  RODB  Float  Component  to  a disk  file 

procedure  Save_F Its (Out file  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put (Outf ile,  "Number  Of  Floats  is  ") ; 

Int_IO. put (Outf ile,  RCDT. FLT_SIZE) ; 
new_line (Outf ile) ; 
for  I in  1 . . RCDT . FLT_SI ZE  loop 
put(Outfile,  "Float  number  "); 

Int_IO. put (Out file,  1-1) ; 
put (Out file,  ":"); 

Temp_Addr  :*  Shmaddr  + system. offset (RCDT. FLT_OFFSET  + (I-l)*4) 
Flt_IO . put ( Outf ile,  RCDT . FFLT ( Temp_Addr ) ) ; 
new_line( Out file) ; 
end  loop; 
end  Save_Flts; 

pragma  page; 

begin 

Shmid  RCDT. SHMGET (RCDT. SHMKEY,  RCDT. SHM_SIZE,  1023); 
if  Shmid  » -1  then 
raise  Shm_Exception; 
end  if; 

Shmaddr  :=  RCDT. SHMAT( Shmid,  system. nulladdress,  0); 

— if  Shmaddr  - system. null_address  then 

raise  Shm_Exception; 

— end  if; 

Semid  RCDT. SEMGET (RCDT. SEMKEY,  3,  1023); 
if  Semid  * -1  then 
raise  Sem_Exception; 
end  if; 

end  Rodb_Component ; 
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Job: 

readbeg. 

c 

Date: 

Mon  Mar 

30  01:00:08  1992 

/*  File:  readbeg.c  This  is  read  begin  subroutine  to  set  reading  protection  */ 
^include  <sys/ types. h> 

# include  <sys/ipc.h> 

# include  <sys/sem.h> 

^include  <sys/sched.h> 

# include  <st.h> 

/*  The  operations  on  semaphores  */ 

struct  sembuf  RREAD_START  = { 0,  1,  0>; 

struct  sembuf  RWAIT_NO_WRITE_LOCK  = { 1,  0,  Ob- 
struct sembuf  RWAIT_NO_WRITE_DESIRE  = { 2,  0,  0}; 

int  readbeg (semid) 
int  semid; 

* struct  sembuf  one_of _n_r eaders [ 5 ] ; /*  Three  semaphore  operations  */ 

int  flag; 
void  perror(); 
tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  * getstid(); 
my_prio  * getprio(getpid() ) ; 
fast_setprio(my_tid,  31); 

/*  Perform  three  semaphore  operations,  two  of  them  twice  (see  read. me)  */ 
one  of_n_readers [ 0 ] =*  RWAIT_NO_WRITE_LOCK;  /*  Wait  for  no  more  writers  */ 

one  of _n_r eaders [ 1 ] - RWAIT_NO_WRITE_DESIRE;  /*  Wait  for  no  more  writers  */ 

one_of_n_readers [ 2 ] = RWAIT_NO_WRlTE_LOCK;  /*  Wait  for  no  more  writers  */ 

one_of_n_readers ( 3 ] = RWAIT_NO_WRITE_DESIRE;  /*  Wait  for  no  more  writers  */ 

one_of _n_readers ( 4 ] - RREAD_START ; /*  Prevent  writers  in  */ 

flag  = semop (semid,  one_of _n_readers , 5) ; /*  Lock  the  critical  section  */ 

if  (flag  ~ -1)  { 

perror ("readbeg  fails:  ") ; 

} 

/*  Lower  the  priority  to  normal  */ 
fast_setprio(my_tid,  myjprio) ; 

return  flag; 

} 
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J ob : r eadend . c 

Date:  Mon  Mar  30  01:00:18  1992 


/*  File: 
/include 
/include 
/include 
/include 
/include 


readend.c  This  is  read  end 
< sys/ types. h> 
<sys/ipc.h> 
<sys/sem.h> 

< sy s / sched . h> 

<st.h> 


subroutine  to  reset  protection  */ 


/*  The  operations  on  the  semaphore  */ 
struct  sembuf  RREAD  END  = { 0,  -1,  0} ; 


int  readend(semid) 
int  semid; 

{ 

int  flag; 
void  perror(); 
tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  * getstid ( ) ; 
my__prio  = getprio(getpid() ) ; 
fast_setprio(my_tid,  31); 

/*  Perform  the  semaphore  operation  */ 

flag  - semop( semid,  &RREAD_END,  1);  /*  Unlock  critical  section  */ 

if  (flag  -1)  { 

perror ("readend  fails:  ”) ; 

> 

/*  Lower  the  priority  to  the  normal  */ 
fast_setprio(my_tid,  my_prio) ; 

return  flag; 

} 
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Job:  writebeg.c 

Date:  Mon  Mar  30  01:00:32  1992 


/*  File:  writebeg.c  This  is  write  begin  subroutine  to  set  protection  */ 
/include  <sys/types.h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 


/*  The  operations  on  semaphores  */ 


struct 

sembuf 

WWAIT  NO  READERS 

= 

{ 

o, 

o, 

0}; 

struct 

sembuf 

WREAD  START 

= 

{ 

0, 

Ir 

o>; 

struct 

sembuf 

WWRITE  LOCK 

= 

{ 

1, 

If 

o>; 

struct 

sembuf 

WWRITE  DESIRE 

= 

{ 

2, 

1/ 

o>; 

struct 

sembuf 

WIN  PROGRESS  WRITE 

a b 

{ 

2, 

-1/ 

0}; 

int  writebeg(semid) 
int  semid; 

{ 

struct  sembuf  sole_writer[4] ; /*  Four  semaphore  operations  */ 

int  flag; 

void  perror() ; 

tid_t  my_tid; 

int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  - getstid(); 
my_prio  ■ getprio(getpid() ) ; 
fast_setprio(my_tid,  31) ; 

/*  Make  write  request  by  doing  a semaphore  operation  */ 
flag  - semop( semid,  &WWRITE_DESIRE,  1); 
if  (flag  — -1)  { 

perror ("Write-Request  in  writebeg  fails:  "); 
return  flag; 

> 

/*  Perform  four  semaphore  operations  */ 

sole_writer [0]  * WWAIT_NO_READERS ; /*  Wait  for  no  more  readers  */ 

sole_writer ( 1]  * WWRITE_LOCK;  /*  preventing  succeeding  readers  */ 

sole_writer[2]  * WREAD_START;  /*  preventing  succeeding  writers  */ 

sole_wr iter [ 3 ] = WIN_PROGRESS_WRITE ; /*  Cancel  the  write-request  */ 

flag  - semop( semid,  sole_writer,  4) ; /*  Lock  the  critical  section  * / 

if  (flag  — -1)  { 

perror ( "Write_Start  in  writebeg  fails:  ") ; 

} 

/*  Lower  the  priority  to  the  normal  */ 
fast_setprio(my_tid,  my_prio) ; 

return  flag; 

> 
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Job:  vriteend.c 

Date:  Mon  Mar  30  01:00:58  1992 


/*  File:  writeend.c  This  is  write  end  subroutine  to  reset  write  protection  */ 
/include  <sys/types.h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 
struct  sembuf  WREAD_END  * { 0,  -1,  0}; 

struct  sembuf  WWRITE_UNLOCK  * { 1,  -1,  0}; 

int  writeend(semid) 
int  semid; 

* struct  sembuf  sole_writer [2] ; /*  Two  semaphore  operations  */ 

int  flag; 
void  perror ( ) ; 
tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  = getstid(); 
my_prio  - getprio(getpid() ) ; 
fast_setprio(my_tid,  31); 

/*  Perform  the  semaphore  operation  */ 

sole_wr iter [ 0 ] - WREAD_END ; /*  Allow  writer  in  */ 

sole_wr iter [ 1 ] - WWRITE_UNLOCK;  /*  Allow  reader  in  */ 

flag  * semop ( semid,  sole_writer,  2) ; /*  Unlock  critical  section  */ 

if  (flag  ==  -1)  { 

perror (M writ eend  fails:  " ) ; 

> 

/*  Lower  the  priority  to  the  normal  */ 
fast_setprio(my_tid,  my_prio) ; 

return  flag; 

} 
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Job:  semsinit.c 

Date:  Mon  Mar  30  01:01:24  1992 


/*File:  semsinit.c  This  is  semaphore  init  subroutine  to  initialize  semaphores*/ 
/include  <sys/types.h> 

/include  <sys/ipc«h> 

/include  <sys/sem.h> 
int  semsinit (semid) 
int  semid; 

{ 

short  initarray [ 3 ] ; 
int  flag; 
void  perror(); 

initarray [0]  = initarray[l]  * initarray [2]  * 0; 
flag  = semctl (semid,  3,  SETALL,  initarray); 
if  (flag  =-  -1)  { 

perr or ("semsinit  fails:  ") ; 

> 

return(flag) ; 
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Job : semsrmv . c 

Date:  Mon  Mar  30  01:01:37  1992 


/*  File:  semsrmv.c  This  is  semaphore  remove  subroutine  to  remove  semaphores  */ 
/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semsrmv(semid) 
int  semid; 

{ 

int  flag; 
void  perror ( ) ; 

flag  ■ semctl (semid,  3,  IPC_RMID,  0); 
if  (flag  ™ -1)  { 

perror ("semsrmv  fails:  "); 

} 

return (flag) ; 

} 
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Job:  semprint.c 

Date:  Mon  Mar  30  01:01:48  1992 


/♦File: semprint. c This  is  semaphore  print  subroutine  to  print  semaphore  values*/ 
/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semprint (semid) 
int  semid; 

{ 

short  outarray [ 3 ] ; 
int  flag; 
void  perror ( ) ; 
int  i ; 

flag  = semctl (semid,  3,  GETALL,  outarray); 
if  (flag  ==  -1)  { 

perror ("semprint  fails:  "); 

> 

for  (i-0;  i<3 ; ++i)  { 

printf ("Semaphore  %d  has  the  value  of  %d\n",  i,  outarr ay [ i ] ) ; 

} 

return (flag) ; 


Appendix  C-2 


Uncontested  RODB  Reads 
and 

Uncontested  RODB  Writes 


Semaphore  Protection  in  Place  but  no  Disabling  of  Preemption  (i.e.  no 
raising/lowering  of  priorities) 
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Job:  read. me 

Date:  Wed  Apr  1 19:12:17  1992 


This  directory  stores  all  the  files  to  build  up  RODB  "attribute"  components 
The  protection  mechanism  is  that  locking  is  set  at  the  RODB  level.  Durinq  the 
lock  setting,  there  is  NO  PREVENTION  OF  PREEMPTION.  That  is  to  say  tests 
are  performed  with  semaphores  which  are  not  guaranteed  to  have  atomic 
execution.  Actually  in  the  case  at  hand  that  is  not  a problem  because  the 
reads  and  writes  are  done  in  separate  runs  so  that  they  are  uncontested. 

Before  the  actual  reads  are  begun  the  semaphores  are  tested  and  set.  First, 
a set  of  five  semaphore  operations  are  imposed  upon  the  semaphores.  After  the 
actual  reading  of  the  RODB  component  one  semaphore  operation  is  imposed  on  the 
semaphores.  In  the  case  of  writing,  before  actually  writing  to  the  RODB 
component,  there  are  two  levels  of  operations  to  be  imposed  on  the  semaphores. 
These  operations  are  to  express  a desire  to  write  or  write_desire  and  a 
locking  of  a semaphore  or  write_lock.  To  achieve  the  setting  of  write  desire, 
only  one  semaphore  operation  will  be  imposed  on  the  semaphores  and  for 
After  actually  writing,  a set  of  two  more  semaphore  operations  are  imposed 
upon  the  semaphores. 

A TEST  IS  DONE  TO  MEASURE  HOW  LONG  IT  TAKES  FOR  1000  TO  10000  READS  and  then 
the  same  for  WRITES. 

THE  RESULT  IS  IN  FILE  rodbcomp91.dat  for  reading.  THE  RESULT  FOR  WRITING 
IS  IN  FILE  rodbcomp92.dat 
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Job : rodbt  st 9 1 . ada 

Date:  Wed  Apr  1 19:30:59  1992 


— This  is  the  reading  test  program 

with  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
use  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
procedure  Rodbtst91  is 

— Constant  definitions 

ATTR_SIZE  : constant  integer  :=  200; 

RESULT_SIZE  : constant  integer  :=  10; 

— Data  type  definition 
type  Result_Type  is  record 

Loops  : integer ; 

Times  : duration; 
end  record; 


— Package  instantiation 

package  INT_I0  is  new  TEXT_I0. INTEGER_IO( integer ) ; 
package  FIX_IO  is  new  TEXTIO. FIXED_I0 (duration) ; 
package  RCDT  renames  RODB_Component_Data_Types ; 
package  RODBCP  renames  RODB_Component ; 


— Variable  definition 


Length 

Number  Of_Times 

Addr_LTst 

Attr_List 

Start_Time 

Finish_Time 

Results 

Outfile 


integer ; 
integer ; 

RCDT . Pos_List_Type ( 1 . . ATTR_SIZE) ; 
RCDT . Attr_L i s t_Type ( 1 . . ATTR_SIZE) ? 
CALENDAR. time; 

CALENDAR. time; 

array (1. .RESULT_SIZE)  of  Result_Type; 
file_type; 


begin 

RODBCP . Load_Comps ( "rodbcomp . dat H ) ; 

Length  : - 1 ; 

Addr_List ( 1 ) : * 0 ; 

Number  Of_Times  :«  1000; 
for  I In  1. .RESULT_SIZE  loop 
Start_Time  CALENDAR. clock; 

for  J in  1 . . Number_0f _Times  loop 

RODBCP. Read_Attr s (Addr_List,  Length,  Attr_List) ; 
end  loop; 

Finish_Time  :«  CALENDAR. clock; 

Results (I)  (Number_Of_Times,  Finish_Time-Start_Time) ; 

Number_Of_Times  : - Number_Of_Times  + 1000; 
end  loop ; 


— Output  the  result  to  a file 

create (Outfile,  out_file,  Hrodbcomp9 1 . out" , 

f orm->" world” > read,  owner-=>read_write" ) ; 
put_line (Outfile,  "NO  Number_Of_Iterations  Times") ; 
for  I in  1.. RESULT  SIZE  loop 

INT_IO . put ( Out f Tie , I,  width  *>  5); 

INT_IO. put (Outfile,  Results (I) .Loops) ; 

FIX_IO. put (Outfile,  Results (I) .Times) ; 
new_line (Outfile) ; 
end  loop; 
close (Outfile) ; 
exception 

when  others  ■> 

put_line("Main  program  exception"); 
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Date:  Wed  Apr  1 19:33:27  1992 


— This  is  the  reading  test  program 

with  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
use  TEXT_IO , CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
procedure  Rodbtst92  is 

— Constant  definitions 

ATTR_SIZE  : constant  integer  :=  200; 

RESULT_S I Z E : constant  integer  :=  10; 

— Data  type  definition 
type  Result_Type  is  record 

Loops  : integer; 

Times  : duration; 
end  record; 


— Package  instantiation 

package  INT_IO  is  new  TEXT_IO . INTEGER_IO ( integer ) ; 
package  FIX_I0  is  new  TEXT_I0. FIXED_I0 (duration) ; 
package  RCDT  renames  RODB_Component_Data_Types ; 
package  RODBCP  renames  RODB_Component ; 


— Variable  definition 


Length 

Number  Of_Times 

Addr_LTst 

Attr_List 

Start_Time 

Finish_Time 

Results 

Out file 


integer ; 
integer ; 

RCDT . Pos_List_Type ( 1 . . ATTR_SIZE) ; 
RCDT . At tr_L i s t_Type ( 1 . . ATTR_SIZE) ; 
CALENDAR. time; 

CALENDAR . t ime ; 

array (1. .RESULT_SIZE)  of  Result_Type; 
file_type; 


begin 

RODBCP . Load_Comps ( " r odbcomp . dat " ) ; 

Length  :=  1; 

Addr_List ( 1 ) : = 0 ; 

Attr_List(l)  (Type_ID  =>  0,  Int_Value  =>  200); 

Number  Of_Times  : = 1000; 
for  I In  1. .RESULT_SIZE  loop 
Start_T ime  : * CALENDAR . clock ; 
for  J in  1 . . Number_Of_Times  loop 

RODBCP. Write_Attrs(Addr_List,  Length,  Attr_List) ; 
end  loop; 

Finish_Time  : * CALENDAR . clock ; 

Results (I)  (Number_Of_Times,  Finish_Time-Start_Time) ; 

Number_Of_Times  Number_Of_Times  + 1000; 
end  loop; 


— Output  the  result  to  a file 

create (Out file,  out_file,  "r odbcomp 9 2. out", 

form*>"world=»>read,  owner»>read_write")  ; 
put_line (Out file,  "NO  Number_Of_Iterations  Times"); 
for  I in  1.. RESULT  SIZE  loop 

INT_IO . put ( Out f Tie , I,  width  ->  5); 

INT_IO. put (Out file.  Results (I) .Loops) ; 

FIX_IO.put (Outf ile,  Results(I) .Times) ; 
new_line( Out file) ; 
end  loop; 
close (Out file) ; 
exception 

when  others  =*> 


put_line(”Main  program  exception”); 


end  Rodbtst92; 
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NO  Number  Of  Iterations 
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— This  package  provides  the  constants,  instantiated  packages,  system  calls 

— and  C functions  interfaces  to  C language  for  RODB  COMPONENT  packaqe 
with  TEXT_IO,  SYSTEM; 

use  TEXT_IO,  SYSTEM; 

package  RODB_COMPONENT  DATA  TYPES  is 


— Constants 


I NT 

SIZE 

constant 

integer 

CHAR 

SIZE 

constant 

integer 

BOOL 

SIZE 

constant 

integer 

FLT 

SIZE 

constant 

integer 

SHMKEY 

constant 

integer 

SEMKEY 

constant 

integer 

integer 

SHM 

SIZE 

constant 

CHAR 

_OFFSET 

constant 

integer 

BOOL 

_OFFSET 

constant 

integer 

FLT 

OFFSET 

constant 

integer 

10; 

10; 

10; 

10; 

99; 

100; 


INT_SIZE*4+CHAR_SIZE+BOOL  SIZE+4*FLT  SIZE 
INT_SIZE*4 ; 

CHAR_OFFSET  + CHAR_SIZE*1; 

BOOL_OFFSET  + BOOLSIZE*!; 


— Data  types 

type  Attr_Type(Type_ID  : integer  :=  0)  is  record 
case  Type_ID  is 
when  0 *> 

Int_Value  : integer; 
when  1 => 

Char_Value  : character; 
when  2 =■> 

Bool_Value  : boolean; 
when  3 => 

Flt_Value  : float; 
when  others  *> 

null; 
end  case; 
end  record; 

type  Attr_List_Type  is  array ( integer  range  <>)  of  Attr  Type; 
type  Pos_List_Type  is  array ( integer  range  <>)  of  integer; 


— Package  instantiation 

package  INT_IO  is  new  TEXT_IO. INTEGER_IO( integer) ; 
package  BOOL_IO  is  new  TEXT_IO. ENUMERATION_IO( boolean) ; 
package  FLT_IO  is  new  TEXT_IO.FLOAT_IO (float) ; 
function  FINT  is  new  system. fetch_f rom_address ( integer) ; 
function  FCHAR  is  new  system. fetch_from_address (character) ; 
function  FBOOL  is  new  system. fetch_from_address (boolean) ; 
function  FFLT  is  new  system. fetch_from_address (float) ; 
procedure  AINT  is  new  system. assign_to_address( integer) ; 
procedure  A CHAR  is  new  system. assign_to_address (character) ; 
procedure  ABOOL  is  new  system. assign_to_address (boolean) ; 
procedure  AFLT  is  new  system. assign_to_address (float) ; 


— Shaded  memory  system  call  interface 
function  SHMGET(KEY  : in  integer; 

SIZE  : in  integer; 

FLAG  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SHMGET) ; 
pragma  I NTERFACE_NAME ( SHMGET , " shmget H ) ; 
function  SHMAT ( SHMID  : in  integer; 

SHMADDR  : in  system. address; 

FLAG  : in  integer)  return  system. address; 

pragma  INTERFACE (C,  SHMAT); 
pragma  INTERFACE_NAME( SHMAT,  "shmat") ; 


function  SHMDT ( SHMADDR  : in  system. address)  return  integer 

pragma  INTERFACE (C,  SHMDT); 

pragma  INTERFACE_NAME ( SHMDT , " shmdt " ) ; 

function  SHMCTL ( SHMID  : in  integer? 

CMD  : in  integer; 

BUFF  : in  system. address)  return  integer 

pragma  INTERFACE (C,  SHMCTL); 
pragma  INTERFACE_NAME ( SHMCTL,  "shmctl") ; 

— Semaphore  system  call  and  C function  interface 
function  SEMGET (KEY  : in  integer; 

NSEMS  : in  integer; 

FLAG  : in  integer)  return  integer; 

pragma  INTERFACE (C,  SEMGET); 
pragma  INTERFACE_NAME ( SEMGET , " semget" ) ; 
function  SEMSINIT(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMSINIT); 
pragma  INTERFACE_NAME( SEMSINIT,  "semsinit"); 
function  SEMPRINT ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMPRINT); 
pragma  INTERFACE_NAME ( SEMPRINT,  "semprint") ; 
function  READBEG( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READBEG) ; 
pragma  INTERFACE_NAME ( READBEG , " r eadbeg " ) ; 
function  READEND ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READEND) ; 
pragma  INTERFACE_NAME (READEND,  "readend"); 
function  WRITEBEG( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEBEG) ; 
pragma  INTERFACE_NAME (WRITEBEG,  "writebegH) ? 
function  WRITEEND( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEEND); 
pragma  INTERFACE_NAME (WRITEEND,  "writeend")  ; 
function  SEMSRMV ( SEMID  : in  integer)  return  integer? 
pragma  INTERFACE (C,  SEMSRMV); 
pragma  INTERFACE_NAME( SEMSRMV,  "semsrmv") ; 

end  RODB_Component_Data_Types; 
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with  TEXT_IO , SYSTEM,  Rodb_Component_Data_Types ; 
use  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
package  Rodb_Component  is 

— Package  renaming 

package  RCDT  renames  Rodb_Component_Data_Types; 

— Exception  definition 
Shm_Exception  : exception; 

Shm_Outrange  : exception; 

Sem_Exception  : exception; 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  out  RCDT.Attr_List_Type) ; 

— Write  attributes  to  RODB  components 

procedure  Write_Attrs(Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  RCDT. Attr_List_Type) 

— Print  out  the  semaphore  values 

procedure  Print_Sems; 

— Load  RODB  components  from  a disk  file 

procedure  Load_Comps (Filename  : in  string); 

— Save  RODB  components  to  a disk  file 

procedure  Save_Comps (Filename  : in  string); 

— Shutdown  the  RODB  components 
procedure  Shutdown_Comps ; 


end  RODB  COMPONENT; 
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with  TEXT  10,  CALENDAR,  SYSTEM,  PREEMPTION_CONTROL,  Rodb_Component_Data_Types 
use  TEXT~I0,  CALENDAR,  SYSTEM,  PREEMPT I 0N_C0NTR0L , Rodb_Component_Data_Types 
package  body  Rodb_Component  is 

— Local  variables 
Shmid  : integer; 

Shmaddr  : system. address; 

Semid  : integer; 


— Local  subprograms 
procedure  Load_Ints ( Infile 
procedure  Load_Char s (Infile 
procedure  Load_Bools (Inf ile 
procedure  Load_Flts (Inf ile 
procedure  Save_Ints (Outf ile 
procedure  Save_Chars (Outf ile 
procedure  Save_Bools ( Outf i le 
procedure  Save_Flts (Outf ile 


in 

FILE  TYPE) 

in 

FILE  TYPE) 

in 

FILE  TYPE) 

in 

FILE  TYPE) 

in 

FILE  TYPE) 

in 

FILE  TYPE) 

in 

FILE  TYPE) 

in 

FILE  TYPE) 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  out  RCDT.Attr_List_Type)  is 
Temp  : system. address; 

Flag  : integer; 
begin 

— PREEMPTION_CONTROL . DISABLE_PREEMPTION ; 

Flag  :«  RCDT. READBEG (Semid) ; 

— PREEMPTION_CONTROL . ENABLE_PREEMPTION ; 
if  Flag  *»  -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1 . . Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr_List (I)  > RCDT.SHM_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp  :=  Shmaddr  + system. offset (Addr_List (I) ) ; 
if  (Addr  List (I)  < RCDT . CHAR_OFFSET ) then 

Attr_Llst(I)  (Type_ID  *>  0,  Int_Value  =>  RCDT. FINT (Temp) ) ; 
elsif  (Addr  List(I)  < RCDT . BOOL_OFFSET)  then 

Attr_List ( I ) :«  (Type_ID  =>  1,  Char_Value  ->  RCDT. FCHAR (Temp) ) ; 
elsif  ( Addr_List ( I ) < RCDT. FLT_OFFSET)  then 

Attr_List(I)  :*  (Type_ID  =>  2,  Bool_Value  »>  RCDT. FB00L (Temp) ) ; 
dXsd 

Attr_List (I)  (Type_ID  ->  3,  Flt_Value  =»>  RCDT. FFLT (Temp) ) ; 

end  if ; 
end  loop; 

— delay  10.0; 

— PREEMPTI0N_C0NTR0L . DISABLE_PREEMPTION ; 

Flag  :«  RCDT.READEND (Semid) ; 

— PREEMPTION_CONTROL . ENABLE_PREEMPTION ; 
if  Flag  ■ -1  then 

raise  Sem_Exception; 
end  if ; 

end  Read  Attrs; 


— Write  attributes  to  RODB  components 
procedure  Write_Attrs (Addr_List  : in 

Length  : in 
Attr  List  : in 


RCDT . Pos_List_Type ; 
integer; 

RCDT.Attr_List_Type)  is 


Temp  : system. address; 

Flag  : integer; 
begin 

— PREEMPTION_CONTROL.DISABLE_PREEMPTION; 

Flag  :■  RCDT. WRITEBEG (Semid) ; 

— PREEMPTION_CONTROL. ENABLE  PREEMPTION ; 
if  Flag  - -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1. . Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr_List (I)  > RCDT.SHM  SIZE-1)  then 
raise  Shm_Outr ange ; ~ 

end  if; 

Temp  :■  Shmaddr  + system. offset (Addr_List (I) ) ; 
if  (Addr_List (I)  < RCDT . CHAR_OFFSET)  then 
RCDT . AINT ( Temp , Attr_List (I) . Int_Value ) ; 
elsif  (Addr_List (I)  < RCDT. BOOL_OFFSET)  then 
RCDT. ACHAR (Temp,  Attr_List(I) . Char_Value) ; 
elsif  (Addr_List (I)  < RCDT. FLT_OFFSET)  then 
RCDT. ABOOL( Temp,  Attr_List (I) . Bool  Value); 
else  — 

RCDT. AFLT( Temp,  Attr_List (I) . Fit  Value); 
end  if;  — 

end  loop ; 

— delay  10.0; 

— PREEMPTION_CONTROL. DISABLE  PREEMPTION; 

Flag  RCDT. WRITEEND( Semid) ;~ 

— PREEMPTION_CONTROL. ENABLE  PREEMPTION; 
if  Flag  - -l  then 

raise  Sem_Exception; 
end  if; 

end  Write_Attrs; 

— Print  out  the  semaphore  values 
procedure  Print_Sems  is 
Flag  : integer; 
begin 

Flag  : = RCDT. SEMPRINT( Semid) ; 
if  Flag  - -l  then 

raise  Sem_Exception; 
end  if; 

end  Print_Sems; 

— Load  RODB  Components  from  a disk  file. 

— The  structure  of  disk  file  is  as  following: 

Number_Of_Integers 
Positionl  Integerl 
Position2  Integer 2 

• • * 

Number_Of_Characters 
Positionl  Character l 
Position2  Character 
■ # • 

Numb«r_0f_Boo leans 
Positionl  Booleanl 
Position2  Boolean2 
• • • 

Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 


string)  is 


procedure  Load  Comps (Filename  : in 
Infile  : FILljTYPE; 

Temp  : system. address; 

Flag  : integer; 
begin 

open(Infile,  in_file,  Filename); 

— Initialize  RODB  Integer  Component 
for  I in  1. .RCDT.INT_SIZE  loop 

Temp  :■  Shmaddr  + system. offset( (1-1) *4) ; 

RCDT . AINT ( Temp , 0 ) ; 
end  loop; 

Load_Ints (Infile) ; 

— Initialize  RODB  Character  Component 
for  I in  1. .RCDT.CHAR_SIZE  loop 

Temp  Shmaddr  + system. offset (RCDT. CHAR_OFFSET  + 1-1) ; 
RCDT. ACHAR( Temp,  'X'); 
end  loop ; 

Load_Chars( Infile) ; 

— Initialize  RODB  Boolean  Component 
for  I in  1. ,RCDT.BOOL_SIZE  loop 

Temp  :»  Shmaddr  + system. offset (RCDT. BOOL_OFFSET  + 1-1) ; 
RCDT. ABOOL( Temp,  true) ; 
end  loop; 

Load_Bools (Infile) ; 

— Initialize  RODB  Float  Component 
for  I in  1. .RCDT. FLT_SIZE  loop 

Temp  Shmaddr  + system. offset (RCDT. FLT_OFFSET  + (I-l)*4) 
RCDT . AFLT (Temp , 0.0); 
end  loop; 

Load_Flts (Infile) ; 
close (Inf ile) ; 

Flag  RCDT.SEMSINIT(Semid) ; 
if  Flag  - -1  then 

raise  Sem_Exception; 
end  if; 

exception 

when  name_error  -> 

put_line("File  cannot  be  opened."); 
put_line ("Loading  components  fails!"); 
when  data_error  | end_error  => 

put_line("File  format  is  incompatible."); 
put_line( "Loading  components  fails!"); 
wheri  Sem_Exception  «> 

put_line( "Semaphore  cannot  be  initialized."); 
raise  Sem_Exception; 
when  others  -> 

put_line ( "Unknown  exception . " ) ; 
put_line( "Loading  components  fails!"); 
end  Load_Comps; 

— Save  RODB  Components  to  a disk  file 


— The  structure  of  the  disk  file  is  as  following: 

Number_Of_Integers 
Positionl  Integerl 
Position2  Integer2 
*“  • • • 

Number_Of_Characters 
Positionl  Characterl 
Position2  Character2 
” “ • • • 

Number_Of_Booleans 
Positionl  Booleanl 
Position2  Boolean2 
• • • 

Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 
• • • 

procedure  Save_Comps (Filename  : in  string)  is 
Outfile  : FILE_TYPE; 
begin 

if  Filename  /*  ""  then 

create (Outfile,  out_file.  Filename, 

form=>"world=>read,  owner=>read_write") ; 

Save_Ints (Outfile) ; 

Save_Chars (Outfile) ; 

Save_Bools (Outfile) ; 

Save_Flts (Outfile) ; 
close (Outfile) ; 
else 

Save_lnts (TEXT_IO. standard_output) ; 

Save_Chars (TEXT_IO. standard_output) ; 

Save_Bools (TEXT_IO. standard_output) ; 

Save  Fits (TEXT  10. standard  output); 
end  if 7 
exception 

when  constraint_error  => 

put_line(wRODB  Components  data  collapsed."); 
put_line(" Saving  components  fails!"); 
when  others  -> 

put_line( "Unknown  exception."); 
put_line(" Saving  components  fails!"); 
end  Save_Comps ; 

— Shutdown  RODB  Components 
procedure  Shutdown_Comps  is 

Flag  : integer; 
begin 

Flag  : - RCDT . SHMDT ( Shmaddr ) ; 
if  Flag  - -l  then 
r$ise  Shm_Exception; 
end.  if; 

Flag  :»  RCDT. SHMCTL(Shmid,  0,  system. null  address); 
if  Flag  - -1  then 

raise  Shm_Exception; 
end  if; 

Flag  RCDT.SEMSRMV(Semid) ; 
if  Flag  * -1  then 
raise  Sem_Exception; 
end  if; 

end  Shutdown_Comps ; 


pragma  page; 


— Load  all  the  Integers  from  a disk  file  to  RODB  Integer  Component 
procedure  Load  Ints (Infile  : in  FILE_TYPE)  is 

Length  : Integer; 

Temp_Pos  : integer; 

Temp_lnt  : integer; 

Temp_Addr  : system. address; 
begin 

INT_IO. get (Infile,  Length); 

skip_line( Infile) ; 

for  I in  1 . . Length  loop 

INT_IO . get (Infile,  Temp_Pos ) ; 

INT_IO . get ( Infile , Temp_Int) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. INT_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :»  Shmaddr  + system. offset (Temp_Pos*4) ; 

RCDT. AINT(Temp_Addr,  Temp_Int) ; 
end  loop; 
end  Load_Ints; 

— Load  all  the  charaters  from  a disk  file  to  RODB  Character  Component 
procedure  Load  Chars (Infile  : in  FILE_TYPE)  is 

Length  : Integer; 

Temp_Pos  : integer ; 

Temp_Char  : character ; 

Temp_Addr  : system . address ; 
begin 

INT_IO. get (Infile,  Length); 

skip_line (Infile) ; 

for  I in  1 . . Length  loop 

INT_IO.get (Inf ile,  Temp_Pos) ; 

get (Infile,  Temp_Char) ; — Skip  a space 

get (Infile,  Temp_Char) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.CHAR_SIZE-1)  then 
raise  Shm_Outrange; 
end  if; 

Temp_Addr  : ■ Shmaddr  + system. offset (RCDT. CHAR_OFFSET+Temp_Pos) ; 
RCDT . ACHAR ( Temp_Addr , Temp_Char) ; 
end  loop; 
end  Load_Chars; 

— Load  all  the  booleans  from  a disk  file  to  RODB  Boolean  Component 
procedure  Load  Bools (Infile  : in  FILE_TYPE)  is 

Length  : Integer; 

Temp_Pos  : integer ; 

Temp_Bool  : boolean; 

Temp_Addr  : system. address; 
begin 

INT_IO. get (Infile,  Length); 

skip_line(Inf ile) ; 

for  I in  1 . . Length  loop 

INT_IO.get(Inf ile,  Temp_Pos) ; 

BOOL_IO. get (Infile,  Temp_Bool) ; 
skip_line( Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.BOOL_SIZE-l)  then 


raise  Shm_Outrange; 
end  if; 

Temp_Addr  Shmaddr  + system. offset (RCDT. BOOL  OFFSET+Temp  Pos) • 
RCDT. ABOOL(Temp_Addr,  Temp_Bool) ; ~ 

end  loop; 
end  Load_Bools; 

— Load  all  the  floats  from  a disk  file  to  RODB  Float  Component 
procedure  Load  Fits (Infile  : in  FILEJTYPE)  is 
Length  : Integer ; 

Temp_Pos  : integer ; 

Temp_Flt  : float; 

Temp_Addr  : system. address; 
begin 

INT_IO.get (Inf ile,  Length); 

skip_line( Infile) ; 

for  I in  1 . . Length  loop 

INT_IO.get(lnfile,  Temp_Pos) ; 

FLT_IO.get (Inf ile,  Temp_Flt) ; 
skip_line(Inf ile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. FLT_SIZE-1)  then 
raise  Shm_Outrange; 
end  if ; 

Temp_Addr  :=  Shmaddr  + system. offset (RCDT. FLT  OFFSET+Temp  Pos*4)  • 
RCDT . AFLT (Temp_Addr , Temp_Flt) ; ~ “ 

end  loop; 
end  Load_Flts; 

pragma  page; 


Save  all  the  integers  from  RODB  Integer  Component  to  a disk  file 
procedure  Save_Ints(Outfile  : in  FILEJTYPE)  is 
Temp_Addr  : system . address ; 
begin 

put (Outfile,  "Number  Of  Integers  is:  ") ; 

Int_IO. put (Out file,  RCDT. INT_SIZE) ; 
new_line(Outfile) ; 
for  I in  1. .RCDT.INT_SIZE  loop 
put (Outfile,  "Integer  number  ") ; 

Int_IO.put(Outfile,  I-l,  width  =>  5); 
put(Outfile,  ":"); 

Temp_Addr  :»  Shmaddr  + system. offset ( (I-l) *4) ; 

Int_IO.put (Outfile,  RCDT. PINT (Temp_Addr) ) ; 
new_line (Outfile) ; 
end  loop; 
end  Save_Ints; 

— Save  all  the  characters  from  RODB  Character  Component  to  a disk  file 
procedure  Save_Chars (Outfile  : in  FILEJTYPE)  is 
Temp_Addr  : system. address;  ~ 

begin . 

put(Outfile,  "Number  Of  Characters  is:  "); 

Int_IO. put (Outfile,  RCDT.CHAR_SIZE) ; 
new_line (Outfile) ; 
for  I in  1. .RCDT.CHAR_SIZE  loop 
put (Outfile,  "Character  number  ") ; 

Int_IO. put (Out file,  I-l,  width  =>  5); 
put (Outfile,  ":"); 

Temp_Addr  :-  Shmaddr  + system. offset (RCDT. CHAR  OFFSET  + I-l) ; 
put (Outfile,  RCDT. FCHAR(Temp_Addr) ) ; 


new_line( Out file) ; 
end  loop; 
end  Save_Chars; 

— Save  all  the  booleans  from  RODB  Boolean  Component  to  a disk  file 

procedure  Save_Bools( Out file  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Booleans  is:  w) ; 
lnt_10.put(0utfile,  RCDT.BOOL_SIZE) ; 
new_line (Out file) ; 
for  I in  1. .RCDT.BOOL_SIZE  loop 
put (Outf ile,  "Boolean  number  "); 

Int_IO. put (Out file,  1-1,  width  »>  5) ; 
put (Out file,  ":"); 

Temp  Addr  : - Shmaddr  + system. offset (RCDT.BOOL_OFFSET  + I-l) ; 
Bool”lO . put (Outf ile , RCDT . FBOOL (Temp_Addr ) ) ; 
new_line( Outf ile) ; 
end  loop; 
end  Save_Bools; 

— Save  all  the  floats  from  RODB  Float  Component  to  a disk  file 

procedure  Save_Flts (Outf ile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Floats  is  "); 

Int_IO. put (Outf ile,  RCDT . FLT_SI ZE) ; 
new_line( Out file) ; 
for  I in  1 . . RCDT . FLT_SI ZE  loop 
put (Outf ile,  "Float  number  "); 

Int_IO.put (Outf ile,  I-l) ; 
put (Outf ile,  ":"); 

Temp_Addr  :*  Shmaddr  + system. offset (RCDT. FLT_OFFSET  + (I-l) *4) 
Flt_IO . put (Outf ile , RCDT . FFLT (Temp_Addr ) ) ; 
new_line( Outf ile) ; 
end  loop; 
end  Save_Flts; 

pragma  page; 

begin 

Shmid  RCDT. SHMGET( RCDT. SHMKEY,  RCDT. SHM_SIZE,  1023); 
if  Shmid  - -1  then 
raise  Shm_Exception; 
end  if; 

Shmaddr  RCDT. SHMAT( Shmid,  system. null_address,  0); 

— if  Shmaddr  - system. null_address  then 

raise  Shm_Exception; 

— end  if; 

Semid  RCDT. SEMGET( RCDT. SEMKEY,  3,  1023); 

if  Semid  - -1  then 
raise  Sem_Exc option; 
end  if; 

end  Rodb_Component ; 
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Job:  readbeg.c 

Date:  Wed  Apr  1 19:35:08  1992 


/*  File:  readbeg.c  This  is  read  begin  subroutine  to  set  reading  protection  */ 
/include  <sys/ types. h> 

/include  <sys/ ipc . h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 

struct  sembuf  RREAD_START  = { 0,  1,  0>; 

struct  sembuf  RWAIT_NO_WRITE_LOCK  = { 1,  0,  Ob- 
struct sembuf  RWAIT_NO_WRITE_DESIRE  - { 2,  0,  0}; 

int  readbeg(semid)  /*  Now  Modified  to  remove  priority  raising  */ 

int  semid; 

* struct  sembuf  one_of_n_readers[5] ; /*  Three  semaphore  operations  */ 

int  flag; 
void  perror ( ) ; 

tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  NOW  DISABLED  I */ 

/*  my  tid  * getstidQ; 
my_jprTo  - getprio(getpid() ) ; 
fast_setprio(my_tid,  31);  */ 

/*  Perform  three  semaphore  operations  where  two  are  repeated  */ 
one_of _n_reader s ( 0 ] - RWAIT_NO_WRITE_LOCK;  /*  Wait  for  no  more  writer  */ 

one_of_n_readers[l]  * RWAIT_NO_WRITE_DESIRE;  /*  Wait  for  no  more  writer  */ 

one_of_n_readers[2]  - RWAIT_NO_WRITE_LOCK;  /*  Wait  for  no  more  writer  */ 

one_of_n_reader s [ 3 ] - RWAIT_NO_WRITE_DESIRE;  /*  Wait  for  no  more  writer  */ 

one_of_n_readers [ 4 ] - RREAD_START ; /*  Prevent  writer  in  */ 

flag  - semop( semid,  one_of_n_readers , 5);  /*  Lock  the  critical  section  */ 

if  (flag  --  -1)  { 

perror ("readbeg  fails:  ") ; 

- } 

/*  Lower  the  priority  to  the  normal  ALSO  DISABLED  1 */ 

/*  fast_setprio(my_tid,  myjprio) ; */ 

return  flag; 

} 
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Job:  readend.c 

Date:  Wed  Apr  1 19:35:17  1992 


/*  File: 
/include 
/include 
/include 
/include 
/include 


readend.c  This  is  read  end 
<sys/ types. h> 
<sys/ipc.h> 
<sys/sem.h> 

< sys / sched . h> 

<st.h> 


subroutine  to  reset  protection  */ 


/*  The  operations  on  the  semaphore  */ 
struct  sembuf  RREAD  END  ~ { 0,  —1,  0}; 


int  readend(semid) 
int  semid; 

{ 

int  flag; 
void  perror ( ) ? 
tid_t  my_tid; 
int  myjprio; 

/*  Raise  the  priority  to  prevent  the  preemption  NOW  DISABLED  ! */ 

/*  my_tid  * getstid(); 

myjprio  * getprio(getpid() ) ; 
f ast_setpr io (my_t id , 31);  * / 

/*  Perform  the  semaphore  operation  */ 

flag  - semop( semid,  *RREAD_END,  1) ; /*  Unlock  critical  section  */ 

if  (flag  — -1)  { 

perror ("readend  fails:  w) ; 

} 

/*  Lower  the  priority  to  the  normal  Not  needed  so  DISABLED  ! */ 

/*  fast_setprio(my_tid,  myjprio) ; */ 

return  flag; 

> 
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Job:  writebeg.c 

Date:  Wed  Apr  1 19:35:27  1992 


/*  File:  writebeg. c This  is  write  begin  subroutine  to  set  protection  */ 
/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 
struct  sembuf  WWAIT_NO_READERS  * { 0,  0,  0}; 

struct  sembuf  WREAD_S TART  = { 0,  1,  0>; 

struct  sembuf  WWRITE_LOCK  * { 1,  1,  Ob- 
struct sembuf  WWRITE_DESIRE  = { 2,  1,  0}; 

struct  sembuf  WIN_PROGRESS_WRITE  - { 2,  -1,  0}; 

int  writebeg(semid) 
int  semid; 

* struct  sembuf  sole_writer[4] ; /*  Four  semaphore  operations  */ 

int  flag; 
void  perror ( ) ; 
tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption,  NOW  DISABLED  ! */ 

/*  my_tid  - getstid(); 

myjprio  - getprio(getpid() ) ; 
fast_setprio(my_tid,  31);  */ 

/*  Make  write  request  by  doing  a semaphore  operation  */ 
flag  » semop (semid,  &WWRITE_DESIRE,  1); 
if  (flag 1)  { 

perror ("Write-Request  in  writebeg  fails:  H) ; 

. return  flag; 

} 

/*  Perform  four  semaphore  operations  */ 

sole_writer(0]  - WWAIT_NO_READERS ; /*  Wait  for  no  more  readers  */ 

sole_wr iter [ 1 ] - WWRITE_LOCK;  /*  preventing  succeeding  readers  */ 

sole  writer (2]  * WREAD_START;  /*  preventing  succeeding  writers  */ 

sole_wr iter [ 3 ] - WIN_PROGRESS_WRITE;  /*  Cancel  the  write-request  */ 

flag  * semop (semid,  sole_writer,  4) ; /*  Lock  the  critical  section  */ 

if  (flag  — -1)  { 

perror ("Write_Start  in  writebeg  fails:  ") ; 

} 

/*  Lower  the  priority  to  the  normal  NOW  not  needed  so  DISABLED  ! */ 

/*  fast_setprio(my_tid,  myjprio) ; */ 

return  flag; 

} 
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Job:  writeend.c 

Date:  Wed  Apr  1 19:35:39  1992 


Q*  Q*  Qi  0u 


/*  File:  writeend.c  This  is  write  end  subroutine  to  reset  write  protection  */ 
# include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/se*.h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 
struct  sembuf  WREAD_END  =*  { 0,  -1,  0}; 

struct  sembuf  WWRITE_UNLOCK  - { 1,  -1,  0>; 

int  writeend(semid) 
int  semid; 

struct  sembuf  sole_writer[2] ; /*  Two  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid_t  my_tid; 

int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  NOW  DISABLED  ! */ 

/*  my_tid  - getstidQ; 

my_prio  - getprio(getpid()); 
fast_setprio(my_tid,  31);  */ 

/*  Perform  the  semaphore  operation  */ 

sole_wr iter [ 0 ] - WREAD_END ; /*  Allow  writer  in  */ 

sole_writer[l]  • WWRITE_UNLOCK;  /*  Allow  reader  in  */ 

flag  * semop( semid,  sole_writer,  2) ; /*  Unlock  critical  section  */ 

if  (flag  — -1)  { 

perror ( "writ eend  fails:  ") ; 

} 

/*  Lower  the  priority  to  the  normal,  NOW  DISABLED  ! */ 

/*  fast_setprio(my_tid,  my_prio) ; */ 

return  flag; 
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Job:  semsinit.c 

Date:  Wed  Apr  1 19:36:11  1992 


/♦File:  semsinlt . c This  is  semaphore  init  svibroutine  to  initialize  semaphores*/ 
#include  <sys/ types. h> 

^include  <sys/ipc.h> 

^include  <sys/sem.h> 
int  semsinit (semid) 
int  semid; 

{ 

short  initarray [ 3 ] ? 
int  flag; 
void  perror ( ) ; 

initarray [0]  - initarray [1]  - initarray [2]  - 0; 
flag  * semctl (semid,  3,  SETALL,  initarray); 
if  (flag  — -1)  { 

perror ("semsinit  fails:  ") ; 

> 

return (flag) ; 
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/*  File:  semsrmv.c  This  is  semaphore  remove  subroutine  to  remove  semaphores  */ 
/include  <sys/types.h> 

/include  <sys/ipc.h> 

/include  <sys/sea.h> 
int  semsrmv(semid) 
int  semid; 

{ 

int  flag; 
void  perror ( ) ; 

flag  - semctl (semid,  3,  IPC_RMID,  0); 
if  (flag  ==  -1)  { 

perror ("semsrmv  fails:  "); 

} 

return (flag) ; 
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Job:  semprint.c 
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/*File:semprint.c  This  is  semaphore  print  subroutine  to  print  semaphore  values*/ 
/include  <sys/types.h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semprint(semid) 
int  semid; 

{ 

short  outarray [ 3 ] ; 
int  flag; 
void  perror() ; 
int  i; 


flag  - semctl (semid,  3,  GETALL,  outarray); 
if  (flag  — -1)  { 

perror ("semprint  fails:  ") ; 

} 

for  (i=0;  i<3 ; ++i)  { 

printf ("Semaphore  %d  has  the  value  of  %d\n", 

} 

return (flag) ; 


i , outarray [ i ] ) ; 


} 


Appendix  C-3 


Uncontested  RODB  Reads 
and 

Uncontested  RODB  Writes 


Two  Disabling  and  Re-enabling  Pairs  for  each  Read  or  Write.  No  Protec- 
tion for  Actual  Reads  or  Writes. 
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Job : rodbtstAl . ada 

Date:  Thu  Apr  9 13:17:43  1992 


This  is  the  reading  test  program  without  semaphores 


with  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Component  Data  Types 
use  TEXT_IO , CALENDAR,  SYSTEM,  RODB_Component~Data~Types * 
procedure  RodbtstAl  is  _ _ / 


RODB_Component ; 
RODB_Component ; 


— Constant  definitions 

ATTR_SIZE  : constant  integer  :=  200; 
RESULT_SIZE  : constant  integer  :=  10; 

— Data  type  definition 
type  Result_Type  is  record 

Loops  : integer ; 

Times  : duration; 
end  record; 


— Package  instantiation 

package  INT_IO  is  new  TEXT_IO. INTEGER_IO( integer) ; 
package  FIX_IO  is  new  TEXT_IO. FIXED_I0 (duration) ; 
package  RCDT  renames  RODB_Component_Data_Types ; 
package  RODBCP  renames  RODB_Component ; 


— Variable  definition 


Length 

Number  Of_Times 

Addr_LTst 

AttrList 

Start_Time 

Finish_Time 

Results 

Outfile 


integer; 
integer ; 

RCDT . Pos_List_Type ( 1 . . ATTR_SIZE) ; 
RCDT . Attr_List  Type ( 1 . . ATTR  SIZE); 
CALENDAR. time;- 
CALENDAR. time; 

array (1. .RESULT  SIZE)  of  Result  Type; 
f ile_type; 


begin 

RODBCP . Load  Comps ( "rodbcomp . dat" ) ; 

Length  1; 

Addr_List ( 1 ) : ■ 0 ; 

Number  Of_Times  :=»  1000; 
for  I In  1. .RESULT_SIZE  loop 
Start_Time  :=  CALENDAR. clock; 

for  J in  1. .Number_Of_Times  loop  — Two  priority  raise/lower  per  read 
RODBCP . Read_Attrs ( Addr_List , Length,  Attr  List); 
end  loop ; ~ 

Finish_Time  CALENDAR. clock; 

Results(I)  :»  (Number_Of_Times,  Finish  Time-Start  Time) ; 
Number_Of_Times  : - Number_Of_Times  + 1000;  ~ 

end  loop; 


— Output  the  result  to  a file 

create (Outfile,  out_file,  "rodbcompl.out”, 

• form=>Mworld=>read,  owner->read  write") 

Put_line( Out file,  "NO  Number  Of  Iterations  Times"); 
for  I in  1.. RESULT  SIZE  loop  ~ ~ 

INT_IO. put (Outfile,  I,  width  =>  5)  ; 

INT_IO. put (Outfile,  Results (I) .Loops) ; 

FIX_IO. put (Outfile,  Results (I) .Times) ; 
new_line (Outfile) ; 
end  loop; 
close (Outfile) ; 
exception 

when  others  »> 
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Job : read . me 

Date:  Thu  Apr  9 13:24:03  1992 


This  directory  stores  all  the  files  to  build  up  RODB  "attribute”  components 
The  protection  mechanism  is  that  locking  is  set  at  the  RODB  level.  To  achieve 
lock  setting,  a prevent ion-of -preemption  system  call  is  used.  This  is  done 
inside  a C function  which  has  been  called  from  Ada.  The  mechanism  used  is 
the  fast_setprio  system  call  which  is  supposed  to  change  priority  expeditiouslv 
WE  ARE  TRYING  TO  SEE  HOW  MUCH  OVERHEAD  THERE  IS  FOR  THE  PRIORITY  CHANGE  SYSTEM 
CALL.  A TEST  IS  DONE  TO  MEASURE  HOW  LONG  IT  TAKES  FOR  1000  TO  10000  READS  AND 
WRITES  (two  priority  raise/lower  per  Read  or  Write  event).  THE  RESULT  IS  IN 
FILE  rodbcompl . out  for  reading.  THE  RESULT  IS  IN  FILE  rodbcomp2 . out  for  writes. 


put_line ( "Main  program  exception"); 


end  RodbtstAl; 
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NO 

Number  Of 

Iterations  Times 

1 

1000 

1.00000 

2 

2000 

2.00000 

3 

3000 

3.00000 

4 

4000 

4.00952 

5 

5000 

5.00000 

6 

6000 

6.00952 

7 

7000 

7.01910 

8 

8000 

8.00952 

9 

9000 

9.00000 

10 

10000 

10.00952 
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rodbtstA2 . ada 

Date:  Thu  Apr  9 13:17:55  1992 


e 


— This  is  the  writing  test  program  without  semaphores 

with  TEXT  10,  CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
use  TEXT~I0,  CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
procedure  RodbtstA2  is 

— Constant  definitions 

ATTR_SIZE  : constant  integer  :=  200; 

RESULT_S I Z E : constant  integer  :=  10; 

— Data  type  definition 
type  Result_Type  is  record 

Loops  : integer; 

Times  : duration; 
end  record; 


— Package  instantiation 

package  INT_IO  is  new  TEXT_IO. INTEGER_IO (integer) ; 
package  FIX_IO  is  new  TEXT_I0. FIXED_I0 (duration) ; 
package  RCDT  renames  RODB_Component_Data_Types ; 
package  RODBCP  renames  RODB_Component ; 


— Variable  definition 


Length 

Number  Of_Times 
Addr_Llst 
Attr_List 
Start_Time 
Finish  Time 


integer ; 
integer ; 

RCDT . Pos_List_Type ( 1 . . ATTR_SIZE) ; 
RCDT.Attr_List_Type(l. . ATTR_SIZE) ; 
CALENDAR. time; 

CALENDAR . t ime ; 


Results 
Out file 


array (1. .RESULT_SIZE)  of  Result_Type; 
f ile_type; 


begin 

RODBCP . Load_Comps ( M r odbcomp . dat H ) ; 

Length  1; 

Addr_List ( 1 ) : * 0 ; 

Attr_List ( 1)  :=  (Type_ID  ->  0,  IntValue  =>  200); 

Number  Of_Times  :=  1000; 
for  I In  1. .RESULT_SIZE  loop 
Start_Time  :=  CALENDAR. clock; 

for  J in  1. .Number_Of_Times  loop  — Two  priority  raise/ lower  per  write 
RODBCP . Wr ite_Attrs ( Addr_List , Length,  Attr_List) ; 
end  loop; 

Finish_Time  :*  CALENDAR. clock; 

Results (I)  (Number_Of_Times,  Finish_Time-Start_Time) ; 
Number_Of_Times  :■  Number_Of_Times  + 1000; 
end  loop; 

— Output  the  result  to  a file 

create (Out file,  out_file,  "rodbcomp2.out", 

form=>"world=>read,  owner*>read_write" ) ; 
put_line (Outf ile , "NO  Number_Of_Iterations  Times"); 

for  I in  1.. RESULT  SIZE  loop 

INT_IO. put (Outf Tie,  I,  width  =>  5); 

INT_IO. put (Outf ile,  Results (I) .Loops) ; 

FIX_IO. put (Outf ile,  Results (I) .Times) ; 
new_line( Out file) ; 
end  loop; 
close (Outf ile) ; 
exception 

when  others  *> 


put_line("Main  program  exception"); 


end  RodbtstA2 ; 
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Number  Of 

Iterations 

1 

1000 

1.05725 

2 

2000 

2.10492 

3 

3000 

3.15259 

4 

4000 

4.21930 

5 

5000 

5.32294 

6 

6000 

6.31470 

7 

7000 

7.37195 

8 

8000 

8.46594 

9 

9000 

9.47681 

10 

10000 

10.57086 

Times 
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10 

0  100 
1 200 

2 300 

3 400 

4 500 

5 600 

6 700 

7 800 

8 900 

9 1000 

10 

0 A 

1 B 

2 C 

3 D 

4 E 

5 F 

6 G 

7 H 

8 I 

9 J 

10 

0 false 

1 false 

2 false 

3 false 

4 false 

5 false 

6 false 

7 false 

8 false 

9 false 

10 

0 100.0 
1 200.0 

2 300.0 

3 400.0 

4 500.0 

5 600.0 

6 700.0 

7 800.0 

8 900.0 

9 1000.0 
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Date:  Thu  Apr  9 13:18:38  1992 


— This  package  provides  the  constants,  instantiated  packages,  system  calls 
and  C functions  interfaces  to  C language  for  RODB  COMPONENT  Dackaae 
with  TEXT_IO,  SYSTEM;  y 

use  TEXT_IO,  SYSTEM; 
package  RODB  COMPONENT  DATA  TYPES  is 


— Constants 

INT_SIZE 

CHAR_SIZE 

BOOL_SIZE 

FLT_SIZE 

SHMKEY 

SEMKEY 

SHM_SIZE 

CHAR_OFFSET 

BOOL_OFFSET 

FLT  OFFSET 


constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 


10; 

10; 

10; 

10; 

99; 

100; 

INT_SIZE*4+CHAR_SIZE+BOOL  SIZE+4*FLT  SIZE 
INT_SIZE*4 ; 

CHAR_OFFSET  + CHAR_SIZE*1; 

BOOL_OFFSET  + BOOL_SIZE*l; 


— Data  types 

type  Attr_Type(Type_ID  : integer  :=  0)  is  record 
case  Type_ID  is 
when  0 => 

Int_Value  : integer; 
when  1 => 

Char_Value  : character; 
when  2 »> 

Bool_Value  : boolean; 
when  3 »> 

Flt_Value  : float; 
when  others  => 

null; 
end  case; 
end  record; 

type  Attr_List_Type  is  array ( integer  range  <>)  of  Attr  Type; 
type  Pos_List_Type  is  array ( integer  range  <>)  of  integer; 


— Package  instantiation 

package  INT_I0  is  new  TEXT_IO. INTEGER_IO( integer) ; 
package  BOOL_IO  is  new  TEXT_I0. ENUMERATION  IO (boolean) ; 
package  FLT_IO  is  new  TEXT_IO. FLOAT_IO (float) ; 
function  FINT  is  new  system. fet ch_from_addr ess (integer) ; 
function  FCHAR  is  new  system. fetch_from_address (character) ; 
function  FBOOL  is  new  system. fetch_from_address (boolean) ; 
function  FFLT  is  new  system. fetch_from_address( float) ; 
procedure  AINT  is  new  system. assign_to_address( integer) ; 
procedure  ACHAR  is  new  system. assigntoaddress (character) ; 
procedure  ABOOL  is  new  system. assign_to_address (boolean) ; 
procedure  AFLT  is  new  system. assign_to_address (float) ; 


— Shared  memory  system  call  interface 
function  SHMGET(KEY  : in  integer; 

SIZE  : in  integer; 

FLAG  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SHMGET) ; 
pragma  INTERFACE_NAME ( SHMGET,  "shmget"); 
function  SHMAT ( SHMID  : in  integer; 

SHMADDR  : in  system. address; 

FLAG  : in  integer)  return  system. address; 

pragma  INTERFACE (C,  SHMAT); 
pragma  INTERFACE_NAME ( SHMAT , " shmat » ) ; 


function  SHMDT ( SHMADDR  : in  system. address)  return  integer 

pragma  INTERFACE (C,  SHMDT); 

pragma  INTERFACE_NAME ( SHMDT , " shmdt " ) ; 

function  SHMCTL ( SHMID  : in  integer; 

CMD  : in  integer; 

BUFF  : in  system. address)  return  integer 

pragma  INTERFACE (C,  SHMCTL); 
pragma  INTERFACE_NAME ( SHMCTL , " shmct 1”) ; 

— Semaphore  system  call  and  C function  interface 
function  SEMGET(KEY  : in  integer; 

NSEMS  : in  integer; 

FLAG  : in  integer)  return  integer; 

pragma  INTERFACE (C,  SEMGET) ; 
pragma  INTERFACE_NAME ( SEMGET , "semget" ) ; 
function  SEMSINIT(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE ( C , SEMSINIT); 
pragma  INTERFACE_NAME( SEMSINIT,  "semsinit"); 
function  SEMPRINT ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMPRINT); 
pragma  INTERFACE_NAME ( SEMPRINT,  "semprint"); 
function  READBEG( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READBEG) ; 
pragma  INTERFACE_NAME( READBEG,  "readbeg") ; 
function  READ END ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READEND) ; 
pragma  INTERFACE_NAME ( READEND , " r eadend  H ) ; 
function  WRITEBEG (SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEBEG); 
pragma  INTERFACE_NAME (WRITEBEG,  "vritebeg") ; 
function  WRITEEND ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEEND); 
pragma  INTERFACE_NAME (WRITEEND,  "writeend") ; 
function  SEMSRMV( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMSRMV) ; 

. pragma  INTERFACE_NAME( SEMSRMV,  "semsrmv"); 

end  RODB_Component_Data_Types ; 
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with  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
use  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
package  Rodb_Component  is 

— Package  renaming 

package  RCDT  renames  Rodb_Component_Data_Types ; 

— Exception  definition 
Shm_Exception  : exception; 

Shm_Outrange  : exception ; 

Sem_Exception  : exception; 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs(Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  out  RCDT.Attr_List_Type) ; 

— Write  attributes  to  RODB  components 

procedure  Write_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  RCDT.Attr_List_Type) ; 

— Print  out  the  semaphore  values 

procedure  Print_Sems; 

— Load  RODB  components  from  a disk  file 

procedure  Load_Comps (Filename  : in  string); 

— Save  RODB  components  to  a disk  file 

procedure  Save_Comps (Filename  : in  string); 

— Shutdown  the  RODB  components 
procedure  Shutdown_Comps ; 


end  RODB_COMPONENT ; 
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with  TEXT_IO,  CALENDAR,  SYSTEM,  PREEMPT ION_CONTROL,  Rodb_Component_Data_Types ; 
use  TEXT_IO,  CALENDAR,  SYSTEM,  PREEMPTION_CONTROL,  Rodb_Component_Data_Types ; 
package  body  Rodb_Component  is 

— Local  variables 
Shmid  : integer ; 

Shmaddr  : system. address; 

Semid  : integer; 


— Local  subprograms 
procedure  Load_Ints (Infile 
procedure  Load_Char s (Infile 
procedure  Load_Bools( Infile 
procedure  Load_Flts ( Infile 
procedure  Save_Ints ( Out f i le 
procedure  Save_Char s ( Out f i le 
procedure  Save_Bools (Outf ile 
procedure  Save_Flts (Outf ile 


in  FILE_TYPE) 
in  FILE_TYPE) 
in  FILE_TYPE) 
in  FILE_TYPE) 
in  FILE_TYPE) 
in  FILE_TYPE) 
in  FILE_TYPE) 
in  FILE_TYPE) 


— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  out  RCDT . Attr_List_Type ) is 
Temp  : system. address; 

Flag  : integer; 
begin 

— PREEMPTION_CONTROL. DISABLE_PREEMPTION; 

Flag  RCDT.READBEG (Semid) ; 

— PREEMPTION_CONTROL . ENABLE_PRE EMPT ION ; 
if  Flag  * -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1 . . Length  loop 

if  (Addr_List(I)  < 0)  or  (Addr_List (I)  > RCDT.SHM_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp  :»  Shmaddr  + system. offset (Addr_List( I) ) ; 
if  (Addr  List (I)  < RCDT . CHAR_OFFSET)  then 

Attr_Llst(I)  :*  (Type_ID  =>  0,  Int_Value  =>  RCDT. FINT( Temp) ) ; 
elsif  (Addr_List (I)  < RCDT . BOOL_OFFSET)  then 

Attr_List (I)  (Type_ID  =>  1,  Char_Value  ->  RCDT. FCHAR (Temp) ) ; 
elsif  (Addr_List (I)  < RCDT . FLT_OFFSET)  then 

Attr_List (I)  (Type_ID  =>  2,  Bool_Value  =>  RCDT. FBOOL (Temp) ) ; 
else 

Attr_List ( I ) (Type_ID  =>  3,  Flt_Value  =>  RCDT. FFLT (Temp) ) ; 

end  if; 
end  loop; 

— delay  10.0; 

— PREEMPTION_CONTROL . DI SABLE_PREEMPT I ON ; 

Flag . : - RCDT . READEND ( Semid) ; 

— PREEMPTION_CONTROL . ENABLE_PREEMPT I ON ; 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

end  Read  Attrs; 


— Write  attributes  to  RODB  components 
procedure  Write_Attrs(Addr_List  : in 

Length  : in 
Attr  List  : in 


RCDT . Pos_List_Type ; 
integer; 

RCDT.Attr_List_Type)  is 


Temp  : system. address; 

Flag  : Integer; 
begin 

— PREEMPTION_CONTROL . D I SABLE_PREEMPT ION ; 

Flag  RCDT.WRITEBEG (Semid) ; 

— PREEMPTION_CONTROL.ENABLE_PREEMPTION; 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1..  Length  loop 

if  (Addr_List(I)  < 0)  or  (Addr_List (I)  > RCDT. SHM  SIZE- 1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp  :=  Shmaddr  + system. offset (Addr_List( I) ) ; 
if  (Addr_List (I)  < RCDT . CHAR_0FFS ET ) then 
RCDT. AINT( Temp,  Attr_List(I) .Int_Value) ; 
elsif  (AddrJList (I)  < RCDT . BOOL_OFFSET)  then 
RCDT. ACHAR( Temp,  Attr_List(I) .Char_Value) ; 
elsif  (Addr_List(I)  < RCDT . FLT_OFFSET)  then 
RCDT. ABOOL (Temp,  Attr_List(I) .Bool_Value) ; 
else 

RCDT. AFLT( Temp,  Attr_List(I) .Flt_Value); 
end  if; 
end  loop; 

— delay  10. 0; 

— PREEMPT I ON_CONTROL . DISABLE_PREEMPTION ; 

Flag  RCDT . WRITEEND ( Semid) ; 

— PREEMPTION_CONTROL . ENABLE  PREEMPTION ; 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

end  Write_Attrs; 

— Print  out  the  semaphore  values 
procedure  Print_Sems  is 
Flag  : integer; 
begin 

Flag  RCDT. SEMPRINT (Semid) ; 
if  Flag  - -l  then 

raise  Sem_Exception ; 
end  if; 

end  Print_Sems; 

— Load  RODB  Components  from  a disk  file. 

— The  structure  of  disk  file  is  as  following: 

— Number_Of_lntegers 

— Positionl  Integerl 

Position2  Integer 2 

• • • 

Number_Of_Characters 
Positionl  Characterl 
Position2  Character 2 

• • • 

Number_Of_Boo leans 

— Positionl  Booleanl 

Position2  Boolean2 
• • • 

Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 


/♦File : semprint . c This  is  semaphore  print  subroutine  to  print  semaphore  values*/ 
# include  <sys/types.h> 
t include  <sys/ipc.h> 

# include  <sys/sem.h> 
int  semprint (semid) 
int  semid; 

{ 

short  outarray [ 3 ] ; 
int  flag; 
void  perror ( ) ; 
int  i ; 


flag  = semctl (semid,  3,  GETALL,  outarray); 
if  (flag  =«  -1)  { 

perror ("semprint  fails:  ") ; 

> 

for  (i=0;  i<3 ; ++i)  { 

printf ("Semaphore  %d  has  the  value  of  %d\n", 

> 

return (flag) ; 


i,  outarray(i] ) ; 


> 


/*  File:  writeend.c  This  is  write  end  subroutine  to  reset  write  protection  */ 
/include  <sys/ types. h>  ' 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 


/*  The  operations  on  semaphores  */ 
struct  sembuf  WREAD_END  ■ { o,  -1,  o>; 

struct  sembuf  WWRITE_UNLOCK  = { l,  -1,  o>; 

int  writeend(semid) 
int  semid; 

{ 

struct  sembuf  sole_writer [2] ; /*  Two  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid__t  my_tid; 

int  my_prio; 


/*  Raise  the  priority  to  prevent  the  preemption  */ 

/*  my_tid  - getstid(); 
my_j>rio  = getprio(getpid()); 
fast_setprio(my_tid,  31);  */ 

/*  Don't  bother  to  raise  a priority  that  wasn't  lowered  by  writebeg  */ 


/*  Perform  the  semaphore  operation  *//*  Commented  out  here  */ 

k a t.pw  A am  r m r.mn«  a mm  . . * 


k sole_wr iter [ 0 ] * WREAD_END;  */ 

* sole_writer[l]  - WWRITE_UNLOCK;  */ 

* flag  - semop( semid,  sole  writer,  2);*/ 
k if  (flag  — -1)  { 

perror ( "writ eend  fails:  ") ; 

} */ 


/*  Allow  writer  in  */ 

/*  Allow  reader  in  */ 

/*  Unlock  critical  section  */ 


/*  Lower  the  priority  to  the  normal  */  /*  Undo  what  writebeg. c did  */ 
fast_setprio(my_tid,  my_prio) ; ' 

return  flag; 

> 
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/*  File:  vritebeg.c  This  is  write  begin  subroutine  to  set  protection  */ 
/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 
struct  sembuf  WWA I T_NO_R EAD ER S = { 0, 

struct  sembuf  WREAD_START  = { 0, 

struct  sembuf  WWRITE_LOCK  = { 1, 

struct  sembuf  WWRITE_DESIRE  = { 2, 

struct  sembuf  WIN_PROGRESS_WRITE  = { 2, 

int  writebeg(semid) 
int  semid; 

{ 

struct  sembuf  sole_writer [4] ; /*  Four  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid_t  my_tid; 

int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  - getstid ( ) ; 
my_prio  - getprio(getpid() ) ; 
fast_setprio(my_tid,  31); 

/*  Make  write  request  by  doing  a semaphore  operation  */  /*  Commented  out  */ 
/*  flag  - semop( semid,  &WWRITE  DESIRE.  1); 
if  (flag  — -1)  { 

perror ( "Write-Request  in  writebeg  fails:  ")  ; 
return  flag; 

> */ 


0,  0} ; 
1,  0 }; 
1#  0>; 
1,  0>; 
-1#  0>; 


/*  Perform  four  semaphore  operations  *//*  All  semops  commented  out  */ 

anl  A ^ r r.TT.T rn  T m nn*  n.  M . . . . • 


f*  sole_writer [0] 
/*  sole_writer[l) 
/*  sole_writer(2] 
/*  sole_wr iter [ 3 ] 


WWAIT_NO_READERS ; */ 
WWRITE_LOCK ; */ 
WREAD_START ; * / 


/*  Wait  for  no  more  readers  */ 

/*  preventing  succeeding  readers  */ 
/*  preventing  succeeding  writers  */ 


WIN_PR0GRESS_WRITE ; */  /*  Cancel  the  write— request  */ 
d,  sole_writer,  4);*/  /*  Lock  the  critical  section  */ 


/*  flag  - semop( semid,  sole  writer,  4) ;*/  /*  i 

/*  if  (flag  — -1)  { 

perror ( "Write  Start  in  writebeg  fails:  "); 
> */ 


/*  Lower  the  priority  to  the  normal  */  /*  Commented  out  here  */ 
/*fast_setprio(my_tid,my_prio) ;*//*postpone  lowering  priority  til  end  of  write*, 

return  0; 

> 
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/*  File: 
/include 
/include 
/include 
/include 
/include 


readend.c  This  is  read  end  subroutine  to  reset 
< sys/ types. h> 

<sys/ipc.h> 

<sys/sem.h> 

<sys/sched.h> 

<st.h> 


protection 


*/ 


/*  The  operations  on  the  semaphore  */ 
struct  sembuf  RREADEND  = { o,  -1,  0}; 

int  readend(semid) 
int  semid; 

{ 

int  flag; 
void  perror() ; 
tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 

/*  my_tid  - getstidQ  ; 
my_prio  - getprio(getpid()); 

fast_setprio(my_tid,  31);  */  /*  Commented  out  already  done  by  readbeg.c  */ 

/*  Perform  the  semaphore  operation  *//*  Semaphore  ops  commented  out  here  */ 

(l  semop( semid,  iRREAD_END,  1);  */  /*  Unlock  critical  section  */ 

/*  if  (flag  — -l)  { ' 

perror ("readend  fails:  ") ; 

> */ 

/*  Lower  the  priority  to  the  normal  */  /*  undo  what  readbeg.c  did  */ 
fast_setprio(my_tid,  my_prio) ; 

return  flag; 

} 
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/*  File:  readbeg.c  This  is  read  begin  subroutine  to  set  reading  protection  */ 
/include  <sys/types.h>  ' 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 
struct  sembuf  RREAD_START  = { o, 

struct  sembuf  RWAIT_NO_WRITE_LOCK  = { 1, 

struct  sembuf  RWAIT_NO_WRITE_DESIRE  = { 2 , 

int  readbeg (semid) 
int  semid; 

{ 

struct  sembuf  one_of_n_readers[5] ; /*  Three  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid_t  my_tid; 

int  my_j?rio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  - getstid(); 
n»y_prio  * getprio(getpid() ) ; 
fast_setprio(my_tid,  31); 

/*  Perform  three  semaphore  operations  *//*  All  semaphores  commented  out  */ 

/*  one_of_n_readers [ 0 ] - RWAIT_NO_WRITE_LOCK;  */  /*  Wait  for  no  more  writer  * 

/*  one_of_n_readers[l]  - RWAIT_NO_WRITE_DESIRE; */  /*  Wait  for  no  more  writer  * 

/*  one_of_n_readers[2]  - RWAIT_NO_WRITE_LOCK;  */  /*  Wait  for  no  more  writer  * 

/*  one_of_n_readers ( 3 ] - RWAIT_N0_WRITE_DES IRE ; * / /*  wait  for  no  more  writer  * 

/*  one_of_n_readers [ 4 ] - RREAD_START ; */  /*  Prevent  writer  in  */ 

/*  flag  - semop( semid,  one_of_n_readers , 5);  */  /*  Lock  the  critical  section  * 

/*  if  (flag  — -l)  { 

perror ("readbeg  fails:  ")  ; 

} */ 

/*  Lower  the  priority  to  the  normal  *//*  not  done  here  for  test  rodbtstBl  */ 
/*  fast_setprio(my_tid,  my_prio);*/ 

return  0;  /*  Commented  out  the  lowering  of  the  priority, that  done  by  readend*, 


1,  0}; 
0,  0}; 
0,  0} ; 
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new_line(Outfile) ; 
end  loop; 
end  Save_Chars; 

— Save  all  the  boo leans  from  RODB  Boolean  Component  to  a disk  file 
procedure  Save_Bools(Outfile  : in  FILE  TYPE)  is 
Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Booleans  is:  "); 

Int_IO.put (Outfile,  RCDT.BOOL_SIZE) ; 
new_line(Outfile) ; 
for  I in  1. .RCDT.BOOL_SIZE  loop 
put (Outfile,  "Boolean  number  ") ; 

Int_IO. put (Outfile,  1-1,  width  *>  5); 
put(Outfile,  ":"); 

Temp_Addr  Shmaddr  + system. offset (RCDT. BOOL  OFFSET  + 1-1) ; 
Bool_IO. put (Out file,  RCDT. FBOOL( Temp  Addr) ) ; 
new_line (Outfile) ; 
end  loop; 
end  Save_Bools; 

— Save  all  the  floats  from  RODB  Float  Component  to  a disk  file 
procedure  Save_Flts (Outfile  : in  FILE_TYPE)  is 
Temp_Addr  : system. address; 
begin 

put (Outfile,  "Number  Of  Floats  is  "); 

Int_IO. put (Out file,  RCDT. FLT_SIZE) ; 
new_line (Outfile) ; 
for  I in  1 . . RCDT . FLT_SI ZE  loop 
put(Outfile,  "Float  number  "); 

Int_IO. put (Outfile,  1-1) ; 
put(Outfile,  ":"); 

Temp_Addr  Shmaddr  + system. offset (RCDT. FLT  OFFSET  + (I-i)*4)- 
Flt_IO. put (Outfile,  RCDT. FFLT( Temp  Addr) ) ; 
new_line (Outfile) ; ~ 

end  loop; 
end  Save_Flts; 

pragma  page; 

begin 

Shmid  RCDT. SHMGET ( RCDT. SHMKEY,  RCDT.SHM  SIZE,  1023); 

if  Shmid  - -1  then 
raise  Shm_Exception ; 
end  if; 

Shmaddr  :«  RCDT. SHMAT( Shmid,  system. null_addr ess,  0); 
if  Shmaddr  ■ system. null_addr ess  then 
raise  Shm_Exception; 

— end  if; 

Semid  :»  RCDT. SEMGET (RCDT. SEMKEY,  3,  1023); 
if  Semid  - -1  then 
raise  Sem_Exception; 
end  if; 

end  Rodb_Component; 


raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :*■  Shmaddr  + system. offset (RCDT.BOOL_OFFSET+Temp_Pos) ; 
RCDT.ABOOL(Temp_Addr,  Temp_Bool) ; 
end  loop; 
end  Load_Bools; 

— Load  all  the  floats  from  a disk  file  to  RODB  Float  Component 
procedure  Load  Fits (Infile  : in  FILE_TYPE)  is 

Length  : Integer; 

Temp_Pos  : integer ; 

Temp_Flt  : float; 

Temp_Addr  : system. address; 
begin 

INT_IO. get (Infile,  Length); 

skip_line( Infile) ; 

for  I in  1 . . Length  loop 

INT_IO . get (Infile,  Temp_Pos ) ; 

FLT_IO. get (Infile,  Temp_Flt) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. FLT_SIZE-1)  then 
raise  Shm_Outr ange ; 
end  if; 

Temp_Addr  Shmaddr  + system. offset (RCDT. FLT_OFFSET+Temp_Pos*4) ; 
RCDT. AFLT(Temp_Addr,  Temp_Flt) ; 
end  loop; 
end  Load_Flts; 

pragma  page; 

— Save  all  the  integers  from  RODB  Integer  Component  to  a disk  file 
procedure  Save_Ints(Outfile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Integers  is:  ") ; 

Int_IO . put ( Outf ile , RCDT. INT_SIZE) ; 
new_line(Outfile) ; 
for  I in  1. .RCDT.INT_SIZE  loop 
put(Outfile,  "Integer  number  ") ; 

Int_IO.put (Outf ile,  1-1,  width  =>  5) ; 
put (Out file,  ":"); 

Temp_Addr  :■  Shmaddr  + system. off set ( (1-1) *4) ; 

Int_IO . put (Outf ile , RCDT . FINT (Temp_Addr ) ) ; 
new_line( Out file) ; 
end  loop; 
end  Save_Ints; 

— Save  all  the  characters  from  RODB  Character  Component  to  a disk  file 
procedure  Save_Chars( Out file  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Characters  is:  "); 

Int_IO. put (Outf ile,  RCDT.CHAR_SIZE) ; 

new_line (Outf ile) ; 

for  I in  1. .RCDT.CHAR_SIZE  loop 

put(Outfile,  "Character  number  ") ; 

Int_IO.put (Outf ile,  1-1,  width  =>  5); 
put (Outf ile,  ":"); 

Temp_Addr  :-  Shmaddr  + system. offset (RCDT. CHAR_OFFSET  + 1-1) ; 
put (Outf ile , RCDT . FCHAR (Temp_Addr ) ) ; 


pragma  page; 


— Load  all  the  integers  from  a disk  file  to  RODB  Integer  Component 
procedure  Load  Ints (Infile  : in  FILE_TYPE)  is 

Length  : Tnteger; 

Temp_Pos  : integer ; 

Temp_Int  : integer; 

Temp_Addr  : system. address; 
begin 

INT_IO.get (Inf ile,  Length) ; 

skip_line (Infile) ; 

for  I in  1 . . Length  loop 

INT_IO. get (Infile,  Temp_Pos) ; 

INT_IO. get (Infile,  Temp_Int) ; 
skip_line ( Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.INT_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :=  Shmaddr  + system. offset (Temp  Pos*4) ; 

RCDT . AINT (Temp_Addr , Temp_Int) ; ~ 

end  loop; 
end  Load_Ints; 

— Load  all  the  charaters  from  a disk  file  to  RODB  Character  Component 
procedure  Load  Chars (Infile  : in  FILE_TYPE)  is 

Length  : Tnteger ; 

Temp_Pos  : integer ; 

Temp_Char  : character ; 

Temp_Addr  : system. address; 
begin 

INT_I0.get (Inf ile.  Length) ; 

skip_line( Infile) ; 

for  I in  1 . . Length  loop 

INT_IO. get (Inf ile,  Temp_Pos) ; 

get (Infile,  Temp_Char) ; — Skip  a space 

get(Infile,  Temp_Char) ; 
skip_line( Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. CHAR  SIZE-1)  then 
raise  Shm_Outr ange ; 
end  if; 

Temp_Addr  Shmaddr  + system. offset(RCDT. CHAR  OFFSET+Temp  Pos); 
RCDT. ACHAR(Temp_Addr,  Temp_Char) ; 
end  loop; 
end  Load_Chars; 

— Load  all  the  booleans  from  a disk  file  to  RODB  Boolean  Component 
procedure  Load  Bools (Infile  : in  FILE  TYPE)  is 

Length  : Tnteger ; 

Temp_Pos  : integer ; 

Temp_Bool  : boolean; 

Temp_Addr  : system. address; 
begin 

INT_I0 . get ( Infile , Length) ; 

skip_line( Infile) ; 

for  I in  1 . . Length  loop 

INT_I0. get (Infile,  Temp_Pos) ; 

BOOL_IO. get (Infile,  Temp  Bool) ; 
skip_line( Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.BOOL_SIZE-l)  then 


— The  structure  of  the  disk  file  is  as  following: 

Number_Of_Integers 
Positionl  Integerl 
Position2  Integer 2 
” ” • • • 

Number_Of_Characters 
Positionl  Characterl 
Position2  Character2 
“ “ • • • 

Number_Of_Booleans 
Positionl  Booleanl 
Position2  Boolean2 
” ^ • « • 

Number_Of_Floats 

— Positionl  Floatl 
Position2  Float2 
• • • 

procedure  Save_Comps (Filename  : in  string)  is 
Outfile  : FILE_TYPE; 
begin 

if  Filename  /*  ""  then 

create (Outfile,  out  file.  Filename, 

form~>"world=>read,  owner=>read_write") ; 

Save_Ints (Outfile) ; 

Save_Chars (Outfile) ; 

Save_Bools (Outfile) ; 

Save_Flts (Outfile) ; 
close (Outfile) ; 
else 

Save_Ints (TEXT_IO. standard_output) ; 

Save_Chars (TEXT_IO. standard_output) ; 

Save_Bools (TEXT_IO. standard_output) ; 

Save_Flts ( TEXT_IO . standard_output ) ; 
end  if; 
exception 

when  constraint_error  ■> 

put_line(MRODB  Components  data  collapsed."); 
put_line( "Saving  components  fails!"); 
when  others  => 

put_l ine ( "Unknown  exception . " ) ; 
put_line( "Saving  components  fails!"); 
end  Save_Comps; 

— Shutdown  RODB  Components 
procedure  Shutdown_Comps  is 

Flag  : integer; 
begin 

Flag  :=  RCDT . SHMDT ( Shmaddr ) ; 
if  Flag  ” -1  then 

raise  Shm_Exception; 
end  if; 

Flag  : * RCDT . SHMCTL ( Shmid , 0,  system. nulladdress) ; 
if  Flag  * -1  then 

raise  Shm_Exception; 
end  if; 

Flag  :=  RCDT . SEMSRMV ( Semid) ; 
if  Flag  - -1  then 

raise  Sem_Exception; 
end  if; 

end  Shutdown_Comps ; 


procedure  Load_Comps (Filename  : in  string)  is 
Infile  : FILE_TYPE; 

Temp  : system. address; 

Flag  : integer; 
begin 

open (Infile,  in_file.  Filename); 

— Initialize  RODB  Integer  Component 
for  I in  1. .RCDT.INT_SIZE  loop 

Temp  Shmaddr  + system. offset( (1-1) *4) ; 

RCDT. AINT (Temp,  0) ; 
end  loop; 

Load_Ints(Inf ile) ; 

— Initialize  RODB  Character  Component 
for  I in  1. .RCDT.CHAR_SIZE  loop 

Temp  Shmaddr  + system. offset (RCDT. CHAR  OFFSET  + 
RCDT. ACHAR( Temp,  'X');  ~ 

end  loop; 

Load_Chars (Infile) ; 

Initialize  RODB  Boolean  Component 
for  I in  1. .RCDT.BOOL_SIZE  loop 

Temp  Shmaddr  + system. offset (RCDT. BOOL  OFFSET  + 
RCDT. ABOOL( Temp,  true) ; 
end  loop; 

Load_Bools (Infile) ; 

— Initialize  RODB  Float  Component 
for  I in  1 . . RCDT . FLT_SIZE  loop 

Temp  :»  Shmaddr  + system. offset (RCDT. FLT  OFFSET  + | 
RCDT. AFLT( Temp,  0.0); 
end  loop; 

Load_Flts( Infile) ; 
close (Infile) ; 

Flag  :»  RCDT.SEMSINIT(Semid) ; 
if  Flag  - -1  then 
raise  Sem_Exception; 
end  if; 

exception 

when  name_error  »> 

put_line("File  cannot  be  opened."); 
put_line( "Loading  components  fails!"); 
when  data_error  | end_error  => 

put_line("File  format  is  incompatible."); 
put_line( "Loading  components  fails!"); 
when  Sem_Exception  -> 

Put_line ("Semaphore  cannot  be  initialized."); 
raise  Sem_Exception; 
when  others  »> 

put_line ( "Unknown  exception . " ) ; 
put_line( "Loading  components  fails!"); 
end  Load_Comps; 


1-1)  ; 


1-1) ; 


-1)*4); 


— Save  RODB  Components  to  a disk  file 


Temp  : system. address; 

Flag  : integer; 
begin 

— PREEMPTION_CONTROL . DISABLE_PREEMPTION ; 

Flag  :*  RCDT.WRITEBEG(Semid) ; 

— PREEMPTION_CONTROL . ENABLE_PREEMPTION ; 
if  Flag  - -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1 . . Length  loop 

if  (Addr_List(I)  < 0)  or  (Addr_List (I)  > RCDT.SHM_SIZE-1 
raise  Shm_Outrange; 
end  if; 

Temp  :=  Shmaddr  + system. offset (Addr_List (I) ) ; 
if  (Addr_List (I)  < RCDT . CHAR_OFFSET)  then 
RCDT . AINT ( Temp , Attr_List(I) .Int_Value) ; 
elsif  (Addr_List (I)  < RCDT . BOOL_OFFSET)  then 
RCDT . ACHAR (Temp , Attr_List (I) . Char_Value) ; 
elsif  (Addr_List(I)  < RCDT . FLT_OFFSET)  then 
RCDT . ABOOL (Temp , Attr_List (I) . Bool_Value) ; 
else 

RCDT . AFLT (Temp , Attr_List (I) . Flt_Value) ; 
end  if; 
end  loop; 

— delay  10.0; 

— PREEMPTION_CONTROL . DISABLE_PREEMPTION ; 

Flag  :*  RCDT.WRITEEND(Semid) ; 

— PREEMPTION_CONTROL . ENABLE_PREEMPTION ; 
if  Flag  =•  -1  then 

raise  Sem_Exception; 
end  if; 

end  Write_Attrs; 

— Print  out  the  semaphore  values 
procedure  Print_Sems  is 
Flag  : integer; 
begin 

Flag  :»  RCDT . SEMPRINT ( Semid) ; 
if  Flag  * -1  then 

raise  Sem_Exception; 
end  if; 

end  Print_Sems; 

— Load  RODB  Components  from  a disk  file. 

— The  structure  of  disk  file  is  as  following: 

Number_Of_Integers 
Positionl  Integerl 
Position2  Integer2 
“ “ • • • 

Number_Of_Characters 
Positionl  Character 1 

Position2  Character2 
• • • 

— Number_Of_Booleans 

— Positionl  Booleanl 

— Position2  Boolean2 


Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 


then 


with  TEXT_IO,  CALENDAR,  SYSTEM,  PREEMPT I ON_CONTROL, 
use  TEXT_IO , CALENDAR,  SYSTEM,  PREEMPTION_CONTROL , 
package  body  Rodb_Component  is 


Rodb_Component  JData  jTypes ; 
Rodb_Component_Data~Types ; 


— Local  variables 
Shmid  : integer ; 

Shmaddr  : system. address; 
Semid  : integer ; 


— Local  subprograms 
procedure  Load_Ints (Infile  : in 
procedure  Load_Chars (Infile  : in 
procedure  Load_Bools( Infile  ; in 
procedure  Load_Flts( Infile  : in 
procedure  Save_Ints(Outfile  : in 
procedure  Save_Chars(Outfile  : in 
procedure  Save_Bools(Outfile  : in 
procedure  Save_Flts(Outfile  : in 


FILE_TYPE) 

FILEJTYPE) 

FILEJTYPE) 

FILEJTYPE) 

FILEJTYPE) 

FILEJTYPE) 

FILEJTYPE) 

FILEJTYPE) 


— Read  attributes  from  RODB  components 

procedure  Read_Attrs(Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer;  ~ 

Attr_List  : in  out  RCDT.Attr  List  Type) 
Temp  : system. address;  — — 

Flag  : integer; 
begin 


is 


— PREEMPTION_CONTROL. DISABLE  PREEMPTION; 
Flag  RCDT. READBEG (Semid) ; 

— PREEMPTION_CONTROL. ENABLE  PREEMPTION; 
if  Flag  * -l  then 

raise  Sem_Exception; 
end  if; 


for  I in  1.. Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr_List (I)  > RCDT.SHM  SIZE-1)  then 
raise  Shm_Outrange ; ~ 

end  if; 

Temp  Shmaddr  + system. offset (Addr  List(I)); 
if  (Addr  List (I)  < RCDT. CHAR_OFFSET)  then 
, Attr_Llst ( 1 ) :■  (Type_ID  *>  0,  Int  Value  =>  RCDT. FINT (Temp) ) ; 
elsif  (Addr_List (I)  < RCDT.BOOL_OFFSlT)  then 

Attr  List(I)  (Type_ID  »>  1,  Char  Value  ->  RCDT. FCHAR (Temp) ) ; 
elsif  (Addr_List (I)  < RCDT. FLT_OFFSETT  then 

^^Attr_List(I)  ;»  (Type_ID  *>  2,  Bool_Value  =>  RCDT. FBOOL (Temp) ) ; 


Attr_List(I)  :■  (Type_ID  =>  3,  Fit  Value 
end  if;  ~ 

end  loop; 

— delay  10.0; 

— PREEMPTION_CONTROL. DISABLE  PREEMPTION; 

Flag  RCDT. READEND( Semid ) ; 

— PREEMPTION_CONTROL . ENABLE  PREEMPTION; 
if  Flag  » -1  then 

raise  Sem_Exception; 
end  if; 

end  Read_Attrs; 


->  RCDT. FFLT (Temp) ) ; 


Write  attributes  to  RODB  components 
procedure  Write_Attrs (Addr_List  : in 

Length  : in 
Attr  List  : in 


RCDT . Pos_List_Type ; 
integer; 

RCDT. Attr_List_Type)  is 
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with  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
use  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
package  Rodb_Component  is 

— Package  renaming 

package  RCDT  renames  Rodb_Component_Data_Types ; 

— Exception  definition 
Shm_Exception  : exception; 

Shm_Outrange  : exception; 

Sem_Exception  : exception; 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer;  — 
Attr_List  : in  out  RCDT.Attr_List_Type) ; 

— Write  attributes  to  RODB  components 

procedure  Write_Attrs(Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer;  ~ 
Attr_List  : in  RCDT.Attr_List_Type) ; 

— Print  out  the  semaphore  values 
procedure  Print_Sems; 

— Load  RODB  components  from  a disk  file 

procedure  Load_Comps (Filename  : in  string); 

— Save  RODB  components  to  a disk  file 

procedure  Save_Comps (Filename  : in  string); 

— Shutdown  the  RODB  components 
procedure  Shutdown_Comps ; 


end  RODB_COMPONENT ; 
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function  SHMDT ( SHMADDR  : in  system. address)  return  integer; 

pragma  INTERFACE (C,  SHMDT); 

pragma  INTERFACE_NAME ( SHMDT , " shmdt" ) ; 

function  SHMCTL ( SHMID  : in  integer; 

CMD  : in  integer; 

BUFF  : in  system. address)  return  integer; 

pragma  INTERFACE (C,  SHMCTL) ; 
pragma  INTERFACE_NAME ( SHMCTL , M shmct 1 " ) ; 

— Semaphore  system  call  and  C function  interface 
function  SEMGET(KEY  : in  integer; 

NSEMS  : in  integer; 

FLAG  : in  integer)  return  integer; 

pragma  INTERFACE (C,  SEMGET) ; 
pragma  INTERFACE_NAME( SEMGET,  "semget"); 
function  SEMSINIT(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE ( C , SEMSINIT); 
pragma  INTERFACE_NAME( SEMSINIT,  "semsinit") ; 
function  SEMPRINT ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMPRINT); 
pragma  INTERFACE_NAME (SEMPRINT,  "semprint") ; 
function  READBEG (SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READBEG); 
pragma  INTERFACE_NAME (READBEG,  "readbeg"); 
function  READEND( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READ END) ; 
pragma  INTERFACE_NAME ( READ END , " readend " ) ; 
function  WRITEBEG( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEBEG) ; 
pragma  INTERFACE_NAME (WRITEBEG,  "writebeg") ; 
function  WRITEEND( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEEND) ; 
pragma  INTERFACE_NAME (WRITEEND,  "writeend") ; 
function  SEMSRMV( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMSRMV) ; 
pragma  INTERFACE_NAME (SEMSRMV,  "semsrmv"); 

end  RODB_Component_Data_Types ; 


package  provides  the  constants,  instantiated  packages,  system  calls 

an(j  q functions  interfaces  to  C language  for  RODB  COMPONENT  package. 

with  TEXT_IO,  SYSTEM; 
use  TEXT_IO , SYSTEM; 

package  RODB_COMPONENT_D ATA_T YPE S is 


10; 

10; 

10; 

10; 

99; 

100; 

INT_SIZE*4+CHAR_SIZE+BOOL_SIZE+4*FLT_SIZE 

INT_SIZE*4; 

CHAR_OFFSET  + CHAR_SIZE*1; 

BOOL  OFFSET  + BOOL  SIZE*1; 


- 0)  is  record 

when  0 => 

Int_Value  : integer; 
when  1 => 

Char_Value  : character; 
when  2 -> 

Bool_Value  : boolean; 
when  3 => 

Flt_Value  : float; 
when  others  => 
null; 
end  case; 
end  record; 

type  Attr_List_Type  is  array ( integer  range  <>)  of  AttrJType; 
type  Pos_List_Type  is  array ( integer  range  <>)  of  integer; 

— Package  instantiation 

package  INT_I0  is  new  TEXT_I0. INTEGER_IO( integer) ; 
package  BOOL_IO  is  new  TEXT_IO. ENUMERATI0N_I0 ( boolean ) ; 
package  FLT_IO  is  new  TEXT_IO.FLOAT_IO (float) ; 
function  FINT  is  new  system. fetch_from_address( integer) ; 
function  FCHAR  is  new  system. fetch_from_address (character) ; 
function  FBOOL  is  new  system. fetch_from_address (boolean) ; 
function  FFLT  is  new  system. fetch_from_address( float) ; 
procedure  AINT  is  new  system. assign_to_address( integer) ; 
procedure  ACHAR  is  new  system. assign_to_address (character) ; 
procedure  ABOOL  is  new  system. assign_to_address (boolean) ; 
procedure  AFLT  is  new  system. ass ign_to_address ( float) ; 

— Shared  memory  system  call  interface 
function  SHMGET(KEY  : in  integer; 

SIZE  : in  integer; 

FLAG  : in  integer)  return  integer; 
pragma  INTERFACE ( C , SHMGET ) ; 
pragma  INTERFACE_NAME ( SHMGET , "shmget") ; 
function  SHMAT ( SHMID  : in  integer; 

SHMADDR  : in  system. address; 

FLAG  : in  integer)  return  system. address; 
pragma  INTERFACE (C,  SHMAT); 
pragma  INTERFACE_NAME ( SHMAT , "shmat") ; 


— Constants 

INT_SIZE 

CHAR_SIZE 

BOOL_SIZE 

FLT_SIZE 

SHMKEY 

SEMKEY 

SHM_SIZE 

CHAR_OFFSET 

BOOL_OFFSET 

FLT  OFFSET 


constant 

constant 

constant 

constant 

constant 

constant 

constant 

constant 

constant 

constant 


integer  : = 
integer  : = 
integer  : = 
integer  : = 
integer  : = 
integer  : = 
integer  : = 
integer  : = 
integer  : * 
integer  : = 


— Data  types 

type  AttrJType (Type_ID  : integer  : 
case  Type  ID  is 
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10 

0  100 
1 200 

2 300 

3 400 

4 500 

5 600 

6 700 

7 800 

8 900 

9 1000 

10 

0 A 

1 B 

2 C 

3 D 

4 E 

5 F 

6 G 

7 H 

8 I 

9 J 

10 

0 false 

1 false 

2 false 

3 false 

4 false 

5 false 

6 false 

7 false 

8 false 

9 false 

10 

0 100.0 
1 200.0 

2 300.0 

3 400.0 

4 500.0 

5 600.0 

6 700.0 

7 800.0 

8 900.0 

9 1000.0 
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NO 


Number  Of 

Iterations 

1 

1000“ 

0.42914 

2 

2000 

0.89508 

3 

3000 

1.32428 

4 

4000 

1.79968 

5 

5000 

2.21936 

6 

6000 

2.69482 

7 

7000 

3.11444 

8 

8000 

3.58990 

9 

9000 

4.01910 

10 

10000 

4.43866 

Times 
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put_line("Main  program  exception") 
end  RodbtstB2; 


— This  is  the  writing  test  program  no  semaphores  just  prevention  of  preemption 
with  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
use  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB~Component ; 
procedure  RodbtstB2  is  ~ 

— Constant  definitions 

ATTR_SIZE  : constant  integer  :=  200; 

RESULT_S I Z E : constant  integer  :=  10; 

— Data  type  definition 
type  Result_Type  is  record 

Loops  : integer ; 

Times  : duration; 
end  record; 


— Package  instantiations 

package  INT_IO  is  new  TEXT_IO. INTEGER_IO( integer) ; 
package  FIX_IO  is  new  TEXT_I0. FIXED_I0 (duration) ; 
package  RCDT  renames  RODB_Component_Data_Types ; 
package  RODBCP  renames  RODB_Component ; 


— Variable  definition 


Length 

Number  Of_Times 

Addr_LTst 

Attr_List 

Start_Time 

Finish_Time 

Results 

Outfile 


integer; 

integer; 

RCDT . Pos_List_Type ( 1 . .ATTR_SIZE) ; 
RCDT . Attr_List_Type ( 1 . . ATTR  SIZE) ; 
CALENDAR. time ; 

CALENDAR. time; 

array (1. .RESULT_SIZE)  of  Result_Type; 
f ile_type; 


begin 

RODBCP . Load_Comps ( "rodbcomp . dat" ) ; 

Length  :=  1; 

Addr_List ( 1)  0; 

Attr_List(l)  :»  (Type_ID  =>  0,  Int_Value  =>  200); 

Number  Of_Times  :*  1000; 
for  I In  1. .RESULT_SIZE  loop 
StartJTime  :=  CALENDAR. clock; 

for  J in  1 . . Number_Of_Times  loop  — One  priority  raise/lower  per  write 
RODBCP . Write_Attrs ( Addr_List , Length,  Attr_List) ; 
end  loop ; 

Finish_Time  CALENDAR. clock; 

Results (I)  (Number_Of_Times,  Finish_Time-Start_Time) ; 

Number_Of_Times  :»  Number_Of_Times  + 1000; 
end  loop; 


— Output  the  result  to  a file 

create (Outfile,  out_file,  Mrodbcomp2 .out” , 

f ormss>”world=>read,  owner=>read_write") ; 
put_line (Outfile,  ”NO  Number_Of_Iterations  Times"); 
for  I in  1.. RESULT  SIZE  loop 

INT_IO. put (Outfile,  I,  width  ~>  5); 

INT_IO. put (Outfile,  Results (I) .Loops) ; 

FIX_IO.put(Outfile,  Results (I) .Times) ; 
new_line (Outfile) ; 
end  loop; 
close (Outfile) ; 
exception 

when  others  =»> 
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NO  Number  Of  Iterations 


1 

1000 

0.48499 

2 

2000 

0.93329 

3 

3000 

1.36237 

4 

4000 

1.85693 

5 

5000 

2.28613 

6 

6000 

2.78064 

7 

7000 

3.21936 

8 

8000 

3.70435 

9 

9000 

4.14307 

10 

10000 

4.62805 

Times 
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This  is  the  reading  test  program  without  semaphores  just  prevent  preemption 

with  TEXT  10,  CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
use  TEXT~I0,  CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
procedure  RodbtstBl  is 

— Constant  definitions 

ATTR_SIZE  : constant  integer  :=  200; 

RESULT_S I Z E : constant  integer  :=  10; 

— Data  type  definition 
type  Result_Type  is  record 

Loops  ; integer ; 

Times  : duration; 
end  record; 


— Package  instantiations 

package  INT_IO  is  new  TEXT_I0. INTEGER_IO( integer ) ; 
package  FIX_I0  is  new  TEXT_I0. FIXED_I0 (duration) ; 
package  RCDT  renames  RODB_Component_Data_Types; 
package  RODBCP  renames  R0DB_Component ; 


— Variable  definition 


Length 

Number  Of_Times 

Addr_List 

Attr_List 

StartJTime 

Finish_Time 

Results 

Outfile 


integer ; 
integer ; 

RCDT . Pos_List_Type ( 1 . . ATTR_SIZE) ; 
RCDT . Attr_L i s t_Type ( 1 . . ATTR_SIZE) ; 
CALENDAR. time; 

CALENDAR. time; 

array(l. .RESULT_SIZE)  of  Result_Type; 
f ile_type; 


begin 

RODBCP . Load_Comps ( Mrodbcomp . dat " ) ; 

Length  : = 1 ; 

Addr_List ( 1 ) : ■ 0 ; 

Number  Of_Times  : =*  1000; 
for  I In  1. .RESULT_SIZE  loop 
Start_Time  : = CALENDAR. clock; 

for  J in  1 . . Number_Of_Times  loop  — One  priority  raise/ lower  per  read 
RODBCP . Read_Attrs ( Addr_List , Length , Attr_List) ; 
end  loop; 

Finish_Time  : - CALENDAR. clock; 

Results(I)  :■  (Number_Of_Times,  Finish_Time-Start_Time) ; 
Number_Of_Times  :■  Number_Of_Times  + 1000; 
end  loop; 


— Output  the  result  to  a file 

create (Outfile,  out_file,  "rodbcompl . out" , 

form*>"world=>read,  owner=>read_write") ; 
put_line (Outfile,  "NO  Number_Of_Iterations  Times"); 

for  I in  1.. RESULT  SIZE  loop 

INT_IO. put (Outfile,  I,  width  =>  5); 

INT_IO. put (Outfile,  Results (I) .Loops) ; 

FIX_IO. put (Outfile,  Results (I ) .Times) ; 
new_line (Outfile) ; 
end  loop; 
close (Outfile) ; 
exception 

when  others  =*> 

put_line ( "Main  program  exception"); 
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Date: 


rodbtstBl . ada 

Sun  Apr  5 16:46:38  1992 


This  is  directory  for  Appendix  C-4 

It  contains  all  the  programs  for  the  "realistic1*  use  of  prevention 
of  preemption  where  priority  is  raised  and  lowered  just  once  for  each 
read  or  write. 
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Appendix  C-4 


Uncontested  RODB  Reads 
and 

Uncontested  RODB  Writes 


Protected  by  Disabling  Preemption  before  each  Read  or  Write  and  Re- 
enabling After. 


PRECEDING  PAGE  BLANK  NOT  FILMED 


/*  File:  semsrmv.c  This  is  semaphore  remove  subroutine  to  remove  semaphores  */ 
/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semsrmv(semid) 
int  semid; 

{ 

int  flag; 
void  perror ( ) ; 

flag  = semctl (semid,  3,  IPC_RMID,  0); 
if  (flag  ==  -1)  { 

perror ("semsrmv  fails:  "); 

} 

return (flag) ; 


PRECEDING  PACE  B*  ANK  NOT  FILMED 
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/♦File:  semsinit.c  This  is  semaphore  init  subroutine  to  initialize  semaphores* 
/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sea.h> 
int  semsinit (semid) 
int  semid; 

{ 

short  initarray [ 3 ] ; 
int  flag; 
void  perror ( ) ; 

initarray [0]  - initarray [1]  * initarray (2]  =*  0; 
flag  ■ semctl (semid,  3,  SETALL,  initarray) ; 
if  (flag  — -1)  { 

perror ("semsinit  fails:  ") ; 

> 

return (flag) ; 
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/*  File: 
# include 
/include 
/include 
/include 
/include 


writeend.c  This  is  write 
<sys/type8.h> 
<sys/ipc.h> 
<sys/sem.h> 
<sys/sched.h> 

<st.h> 


end  subroutine  to 


reset  write 


protection 


*/ 


/*  The  operations  on  semaphores  */ 
struct  sembuf  WREAD_END  - { 0,  -1,  0}; 

struct  sembuf  WWRITE_UNL0CK  - { 1,  -l,  o}; 

int  writeend(semid) 
int  semid; 

{ 

struct  sembuf  sole_writer [2] ; /*  Two  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid_t  my_tid; 

int  my_prio; 


/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  ■ getstid(); 
my_prio  » getprio(getpid() ) ; 
fast_setprio(my_tid,  31); 

/*  P«rform  the  semaphore  operation  */  /*  Commented  out  for  this  test  */ 

/*  sole_wr iter [ 0 ] - WREAD_END ; */  /*  Allow  writer  in  */ 

/*  sole_writer[l]  - WWRITE_UNLOCK;  */  /*  Allow  reader  in  */ 

/*  flag  - semop ( semid , sole_writer,  2);*/  /*  Unlock  critical  section  */ 

/*  if  (flag  — -i)  { 

perror ("writeend  fails:  ")  ; 

} */ 

/*  Lower  the  priority  to  the  normal  */ 
fast_setprio (my_tid,  myjprio) ; 

return  flag; 

} 
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/*  File:  vritebeg.c  This  is  write  begin  subroutine  to  set  protection  */ 
/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 
struct  sembuf  WWAIT_NO_READERS  =■  { 0,  0,  0>; 

struct  sembuf  WREAD_START  “ { 0,  1,  0}; 

struct  sembuf  WWRITE_LOCK  = { l,  1,  0}; 

struct  sembuf  WWRITE_DESIRE  « { 2,  1,  0}; 

struct  sembuf  WIN_PROGRESS_WRITE  * { 2,  -1,  0}; 

int  writebeg(semid) 
int  semid; 

{ 

struct  sembuf  sole_writer [4] ; /*  Four  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid_t  my_tid; 

int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  - getstid ( ) ; 
my_prio  - getprio(getpid() ) ; 
fast_setprio(my_tid,  31); 

/*  Make  write  request  by  doing  a semaphore  operation  *//*Commented  out*/ 

/*  flag  » semop (semid,  &WWRITE  DESIRE,  1) ; 
if  (flag  — -1)  { 

perror ( "Write-Request  in  writebeg  fails:  "); 
return  flag; 

} */ 

/*  Perform  four  semaphore  operations  */  /*  Commented  out  for  this  test  */ 

/*  sole_wr iter [ 0 ] - WWAIT_NO_READERS ; */  /*  Wait  for  no  more  readers  */ 

/*  sole_writer[l]  - WWRITE_LOCK;*/  /*  preventing  succeeding  readers  */ 

/*  sole_writer [2]  * WREAD START ; * / /*  preventing  succeeding  writers  */ 

/*  sole_writer [ 3 ] - WIN_PROGRESS_WRITE;  */  /*  Cancel  the  write-request  */ 

/*  flag  - semop( semid,  sole_writer,  4);*/  /*  Lock  the  critical  section  */ 

/*  if  (flag  — -1)  { 

perror ("Write  Start  in  writebeg  fails:  ") ; 

} */ 

/*  Lower  the  priority  to  the  normal  */ 
fast_setprio(my_tid,  my_prio) ; 

return  flag; 

} 
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/*  File: 
/include 
/include 
/include 
/include 
/include 


readend.c  This  is  read  end  subroutine  to  reset  protection 
< sys/ types. h> 

<sys/ipc.h> 

<sys/sem.h> 

<sys/sched.h> 

<st.h> 


*/ 


/*  The  operations  on  the  semaphore  */ 
struct  sembuf  RREAD_END  =*  { o,  -1,  0}; 

int  readend(semid) 
int  semid; 

{ 

int  flag; 
void  perror ( ) ; 
tid_t  my_tid; 
int  myjprio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  - getstid ( ) ; 
myjprio  - getprio(getpid()); 
fast_setprio(my_tid,  31) ; 

/*  Perform  the  semaphore  operation  */  /*  commented  out  for  this  test  */ 

(1  semop( semid,  &RREAD_END,  1);  */  /*  Unlock  critical  section 

/*  xr  (flag  -l)  { 

perror ("readend  fails:  H)  ; 

} */ 

/*  Lower  the  priority  to  the  normal  */ 
fast_setprio(my_tid,  my_prio) ; 

return  flag; 

} 
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Job:  readend.c 

Date:  Thu  Apr  9 13:19:57  1992 


/*  File:  readbeg.c  This  is  read  begin  subroutine  to  set  reading  nrotection  * / 
/include  <sys/types.h>  y F / 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 


/*  The  operations  on  semaphores  */ 
struct  sembuf  RJREAD_START 
struct  sembuf  RWAIT_NO_WRITE_LOCK 
struct  sembuf  RWAIT_NO_WRITE_DESIRE 

int  readbeg(semid) 
int  semid; 

{ 

struct  sembuf  one_of_n_readers [ 5 ] ; /*  Three  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid_t  my_tid; 

int  my_pr io ; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  - getstid(); 
my_prio  - getprio(getpid() ) ; 
fast_setprio(my_tid,  31); 


- { 0,  1,  0}; 

- { 1/  0,  0); 

* { 2,  0,  0}; 


/*  Perform  three  semaphore  operations 
/*  one_of_n_readers[0]  - RWAIT_NO_WRITE 
/*  one_of_n_reader s [ 1 ] - RWAIT_NO_WRITE 
/*  one_of_n_readers [ 2 ] - RWAIT_N0_WRITE 
/*  one_of_n_readers [ 3 ] =*  RWAIT_NO_WRITE 
/*  one_of_n_readers  [ 4 ] - RREAD_START ; 

/*  flag  * semop (semid,  one  of  n readers, 
/*  if  (flag  »»  -l)  { 

perror ("readbeg  fails:  '*)  ; 

> */ 


*/  /*  Commented  out  for  this  test  */ 
LOCK;  */  /*  Wait  for  no  more  writer  i 

DESIRE;*/  /*  Wait  for  no  more  writer  * 

LOCK;  */  /*  Wait  for  no  more  writer  * 

DESIRE;*/  /*  Wait  for  no  more  writer  * 

/*  Prevent  writer  in  */ 

5) ; */  /*  Lock  the  critical  section  * 


/*  Lower  the  priority  to  the  normal  */ 
fast_setprio(my_tid,  my_prio) ; 

return  flag; 

} 
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new_line (Outfile) ; 
end  loop; 
end  Save_Chars; 

— Save  all  the  booleans  from  RODB  Boolean  Component  to  a 
procedure  Save_Bools(Outfile  : in  FILE  TYPE)  is 
Temp_Addr  : system. address;  ~ 

begin 

put (Out file,  "Number  Of  Booleans  is:  "); 

Int_IO.put (Outfile,  RCDT . BOOL_S I Z E ) ; 
new_line( Out file) ; 
for  I in  1. .RCDT.BOOL_SIZE  loop 
put(Outfile,  "Boolean  number  ") ; 

Int_IO. put (Outfile,  1-1,  width  =>  5); 
put (Outfile,  ":"); 

Temp_Addr  :■  Shmaddr  + system. offset (RCDT. BOOL  OFFSET 
Bool_IO. put (Outfile,  RCDT. FBOOL (Temp  Addr) ) ; ~ 

new_line (Outfile) ; 
end  loop; 
end  Save_Bools; 

Save  all  the  floats  from  RODB  Float  Component  to  a disk 
procedure  Save_Flts (Outfile  : in  FILE  TYPE)  is 
Temp_Addr  : system. address;  ~ 

begin 

put (Outfile,  "Number  Of  Floats  is  "); 

Int_IO. put (Outfile,  RCDT.FLT  SIZE); 
new_line (Outfile) ; ~ 

for  I in  1 . . RCDT.  FLT_SIZE  loop 
put (Outfile,  "Float  number  ") ; 

Int_lO. put (Outfile,  1-1) ; 
put(Outfile,  ":"); 

Temp_Addr  Shmaddr  + system. offset (RCDT.FLT  OFFSET  + 
Flt_IO. put (Outfile,  RCDT . FFLT (Temp  Addr) ) ; 
new_line (Outfile) ; ~ 

end  loop ; 
end  Save_Flts; 

pragma  page; 

begin 

Shmid  RCDT. SHMGET (RCDT. SHMKEY,  RCDT.SHM  SIZE.  1023); 
if  Shmid  - -l  then  ~ 

raise  Shm_Except ion ; 
end  if; 

Shmaddr  :■  RCDT. SHMAT( Shmid,  system. null_address,  0); 

— if  Shmaddr  - system. null_addr ess  then- 

raise  Shm  Exception; 

— end  if; 

Semid  :■  RCDT. SEMGET( RCDT. SEMKEY,  3,  1023); 
if  Semid  - -l  then 
raise'  Sem_Exception; 
end  if; 

end  Rodb_Component ; 


disk  file 


+ i-D; 


file 


(I-l)*4) ; 


raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :*  Shmaddr  + system. offset (RCDT.BOOL_OFFSET+Temp_Pos) ; 
RCDT . ABOOL ( Temp_Addr , Temp_Bool) ; 
end  loop; 
end  Load_Bools; 

— Load  all  the  floats  from  a disk  file  to  RODB  Float  Component 
procedure  Load  Fits (Infile  : in  FILE_TYPE)  is 

Length  : Integer ; 

Temp_Pos  : integer ; 

Temp_Flt  : float; 

Temp_Addr  : system. address; 
begin 

INT_IO. get (Infile,  Length); 

skip_line( Infile) ; 

for  I in  1 . . Length  loop 

INT_IO . get ( Infile , Temp_Pos ) ; 

FLT_IO. get (Infile,  Temp_Flt) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. FLT_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :=  Shmaddr  + system. offset (RCDT. FLT_OFFSET+Temp_Pos*4 ) ; 
RCDT . AFLT ( Temp_Addr , Temp_F 1 t ) ; 
end  loop; 
end  Load_Flts; 

pragma  page; 

— Save  all  the  integers  from  RODB  Integer  Component  to  a disk  file 
procedure  Save_Ints (Out file  : in  FILE_TYPE)  is 

.Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Integers  is:  ") ; 

Int_IO . put ( Outf i le , RCDT. INT_SIZE) ; 
new_line (Outfile) ; 
for  I in  1. .RCDT.INT_SIZE  loop 
put ( Outf ile,  "Integer  number  ") ; 

Int_IO.put (Outfile,  1-1,  width  =>  5) ; 
put (Outf ile,  ":"); 

Temp_Addr  :*  Shmaddr  + system. offset ( ( I— 1) *4) ; 

Int_IO . put (Outfile , RCDT . FINT ( Temp_Addr ) ) ; 
new_line (Outfile) ; 
end  loop; 
end  Save_Ints; 

— Save  all  the  characters  from  RODB  Character  Component  to  a disk  file 
procedure  Save_Chars (Outfile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin  ~ 

put(Outfile,  "Number  Of  Characters  is:  ") ; 

Int_IO. put (Outf ile,  RCDT.CHAR_SIZE) ; 

new_line (Outfile) ; 

for  I in  1. .RCDT.CHAR_SIZE  loop 

put (Outfile,  "Character  number  ") ; 

Int_IO.put (Outf ile,  1-1,  width  =>  5); 
put (Outfile,  ":"); 

Temp_Addr  :*  Shmaddr  + system. offset (RCDT. CHAR_OFFSET  + 1-1) ; 
put (Outfile,  RCDT . FCHAR ( Temp_Addr ) ) ; 


pragma  page; 


Load  all  the  integers  from  a disk  file  to  RODB  Integer  Component 
procedure  Load  Ints( Infile  : in  FILE_TYPE)  is 
Length  : Tnteger ; 

Temp_Pos  : integer ; 

Temp_lnt  : integer; 

Temp_Addr  : system. address; 
begin 

INT_IO. get (Infile,  Length); 

skip_line (Infile) ; 

for  I in  1 . . Length  loop 

INT_IO. get (Infile,  Temp_Pos) ; 

INT_IO. get (Infile,  Temp_Int) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.INT  SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  Shmaddr  + system. offset (Temp  Pos*4); 

RCDT. AINT(Temp_Addr , Temp_Int) ; ~ 

end  loop; 
end  Load_Ints; 


— Load  all  the  charaters  from  a disk  file  to  RODB  Character  Component 
procedure  Load  Chars (Infile  : in  FILE  TYPE)  is  * 

Length  : Tnteger; 

Temp_Pos  : integer ; 

Temp_Char  : character; 

Temp_Addr  : system. address; 
begin 

INT_IO . get (Infile,  Length); 

skip_line (Infile) ; 

for  I in  1 . . Length  loop 

INT_IO.get (Inf ile,  Temp_Pos) ; 
get (Infile,  Temp_Char) ; 
get(Infile,  Temp_Char) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. CHAR  SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :*  Shmaddr  + system. offset (RCDT. CHAR  OFFSET+Temp  Posl • 
RCDT . ACHAR ( Temp_Addr , Temp_Char) ; — — > < 

end  loop; 
end  Load_Chars ; 


— Skip  a space 


Load  all  the  booleans  from  a disk  file  to  RODB  Boolean  Component 
procedure  Load  Bools (Infile  : in  FILE  TYPE)  is 
Length  : Tnteger;  ” 

Temp_Pos  : integer; 

Temp_Bool  : boolean ; 

Temp_Addr  : system. address; 
begin 

INT_I0 . get ( Infile , Length) ; 

skip_line (Infile) ; 

for  I in  1 . . Length  loop 

INT_I0.get (Inf ile,  Temp_Pos) ; 

BOOL_IO. get (Infile,  Temp  Bool); 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.BOOL_SIZE-l)  then 


— The  structure  of  the  disk  file  is  as  following: 

Number_Of_Integers 
Positionl  Integerl 
Position2  Integer 2 
• • • 

Number_Of_Characters 
Positionl  Characterl 
Position2  Character2 
""  • • • 

Number_Of_Booleans 
Positionl  Booleanl 
Position2  Boolean2 
• * • 

— Number_Of_Floats 

— Positionl  Floatl 

— Position2  Float2 

” “ • • • 

procedure  Save_Comps (Filename  : in  string)  is 
Outfile  : FILE_TYPE; 
begin 

if  Filename  /=  ""  then 

create (Outfile,  out_file,  Filename, 

form=>"world=>read,  owner=>read_write") ; 

Save_Ints (Outfile) ; 

Save_Chars (Outfile) ; 

Save_Bools (Outfile) ; 

Save_Flts (Outfile) ; 
close (Outfile) ; 
else 

Save_Ints (TEXT_IO. standard_output) ; 

Save_Chars (TEXT_IO. standard_output) ; 

Save_Bools (TEXT_IO. standard_output) ; 

Save_Flts (TEXT_IO . standard_output ) ; 
end  if; 
exception 

when  constraint_error  => 

put_line(HRODB  Components  data  collapsed."); 
put_line(" Saving  components  fails!"); 
when  others  => 

put_line ( "Unknown  exception . " ) ; 
put_line(" Saving  components  fails!"); 
end  Save_Comps; 

— Shutdown  RODB  Components 
procedure  Shutdown__Comps  is 

Flag  : integer; 
begin 

Flag  : » RCDT . SHMDT  ( Shmaddr ) ; 
if  Flag  = -1  then 

raise  Shm_Exception ; 
end'  if; 

Flag  : ■ RCDT . SHMCTL ( Shmid , 0,  system. null_address) ; 
if  Flag  - -1  then 

raise  Shm_Exception; 
end  if; 

Flag  RCDT . SEMSRMV ( Semid) ; 
if  Flag  * -1  then 

raise  Sem_Exception; 
end  if; 

end  Shutdown_Comps ; 


procedure  Load_Comps (Filename  : in  string)  is 
Infile  : FILEJTYPE; 

Temp  : system. address; 

Flag  : integer; 
begin 

open (Infile,  in_file.  Filename); 

— Initialize  RODB  Integer  Component 
for  I in  1. .RCDT.INT_SIZE  loop 

Temp  :*  Shmaddr  + system. offset ( (1-1) *4) ; 

RCDT . AINT ( Temp , 0)  ; 
end  loop; 

Load_Ints( Infile) ; 

— Initialize  RODB  Character  Component 
for  I in  1. .RCDT.CHAR_SIZE  loop 

Temp  :«  Shmaddr  + system. offset (RCDT. CHAR  OFFSET  + 1-1) • 
RCDT. ACHAR (Temp,  'X');  ~ 

end  loop; 

Load_Chars (Infile) ; 

~ ” Initialize  RODB  Boolean  Component 
for  I in  1. .RCDT.BOOL_SIZE  loop 

Temp  Shmaddr  + system. offset (RCDT. BOOL  OFFSET  + T-ii • 
RCDT . ABOOL ( Temp , true) ; ~ ' 

end  loop; 

Load_Bools( Infile) ; 

Initialize  RODB  Float  Component 
for  I in  1 . . RCDT . FLT_SI ZE  loop 

Temp  Shmaddr  + system. offset (RCDT. FLT  OFFSET  + *1-11*41* 
RCDT. AFLT( Temp,  0.0);  ~ ' > > • 

end  loop ; 

Load_Flts( Infile) ; 
close (Infile) ; 

Flag  RCDT. SEMSINIT(Semid) ; 
if  Flag  - -l  then 
raise  Sem_Exception; 
end  if ; 

exception 

when  name_error  -> 

PU^linet^File  cannot  be  opened."); 
put_line( "Loading  components  fails!"); 
when  data_error  | end_error  *> 

put_line ("File  format  is  incompatible."); 

P*Jt_line( "Loading  components  fails!"); 
when ' Sem_Exception  ■> 

Put_l ("Semaphore  cannot  be  initialized."); 
raise  Sem_Exception; 
when  others  *> 

put_l ine ( "Unknown  exception . " ) ; 
put_line( "Loading  components  fails!"); 
end  Load_Comps; 

— Save  RODB  Components  to  a disk  file 


/♦File:  semsinit.c  This  is  semaphore  init  subroutine  to  initialize  semaphores*/ 
/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semsinit (semid) 
int  semid; 

{ 

short  initarray [ 3 ] ; 
int  flag; 
void  perror ( ) ; 

initarray [0]  * initarray [1]  - initarray [2]  =•  0; 
flag  = semctl (semid,  3,  SETALL,  initarray); 
if  (flag  ==  -1)  { 

perror ("semsinit  fails:  ") ; 

} 

return (flag) ; 


/*  File:  semsrmv.c  This  is  semaphore  remove  subroutine  to  remove  semaphores  */ 
/include  <sys/ types. h>  ' 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semsrmv(semid) 
int  semid; 

{ 

int  f lag ; 

void  perror(); 

flag  - semctl(semid,  3,  IPC  RMID,  0); 
if  (flag  — -1)  { 

perror ("semsrmv  fails:  M) ; 

> 

return (flag) ; 


Appendix  C-5 


Uncontested  RODB  Reads 
and 

Uncontested  RODB  Writes 

No  disabling  of  preemption 
No  Semaphore  Protection 
Just  "raw"  RODB  Reads  and  Writes 


r rrr 

rr  r 

r 

r 

r 

r 


oooo 
o o 

o o 

o o 

o o 

oooo 


oooo 
o o 

o o 

o o 

o o 

oooo 


t 

t 

ttttt 

t 

t 

t 

t t 
tt 


d 

d 

d 


r rrr 

eeee 

aaaa 

ddd 

d 

m 

m mm 

eeee 

rr  r 

e e 

a 

d 

dd 

mm 

m 

m 

e e 

r 

eeeeee 

aaaaa 

d 

d 

m 

m 

m 

eeeeee 

r 

e 

a a 

d 

d 

m 

m 

m 

e 

r 

e e 

a aa 

d 

dd 

• ♦ 

m 

m 

m 

e e 

r 

eeee 

aaaa  a 

ddd 

d 

• • 

m 

m 

m 

eeee 

Job:  read. me 

Date:  Sun  Apr  5 20:20:45  1992 


This  directory  stores  all  the  files  to  build  up  RODB  "attribute"  components. 
The  protection  mechanism  is  absent  for  this  test.  There  is  no  mechanism  used 
to  assure  mutual  exclusion.  Both  the  prevention-of-preemption  by  raising 
process  priority  and  the  semaphore  operations  were  disabled.  WHAT  WE  ARE 
TRYING  TO  MEASURE  IS  THE  TIME  REQUIRED  FOR  JUST  THE  "RAW"  READS  OR  WRITES 
THE  TEST  LOOPS  TO  MEASURE  HOW  LONG  IT  TAKES  FOR  1000  to  10000  READS  OR 
WRITES.  THE  RESULTS  FOR  READING  ARE  IN  FILE  rodbcompl . out  and  the  RESULTS 
FOR  WRITING  ARE  IN  FILE  rodbcomp2 . out . The  reads  and  writes  are 
non-competing . 
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rodbtstCl . ada 

Sun  Apr  5 20:27:34  1992 


— This  is  the  reading  test  program  without  semaphores  or  preemption  prevention 
with  TEXT_IO,  CALENDAR, SYSTEM, RODB_Component_DataJTypes_Mod,  RODB_Component  Mod 

use  TEXT_IO,  CALENDAR, SYSTEM, RODB_Component_Data_Types_Mod,  RODB_Component~Mod 

procedure  RodbtstCl  is  ~ 

— this  program  is  a mod  of  RodbtstSl  to  eliminate  all  protection 

— to  the  shared  memory  just  to  find  out  the  time  to  do  shared  mem  reads 

— Constant  definitions 

ATTR_SIZE  : constant  integer  :=  200; 

RESULT_S I Z E : constant  integer  :=  10; 

— Data  type  definition 
type  Result_Type  is  record 

Loops  : integer ; 

Times  : duration; 

end  record; 

— Package  instantiation 

package  INT_IO  is  new  TEXT_I0. INTEGER_IO( integer) ; 
package  FIX_IO  is  new  TEXT_I0. FIXED_I0 (duration) ; 
package  RCDT  renames  RODB_Component_Data_Types_Mod; 
package  RODBCP  renames  RODB_Component_Mod; 

— Variable  definition 

Length  : integer ; 

Number  OfJTimes  : integer; 

Addr_Llst  : RCDT . Pos_List_Type ( 1 . . ATTR_SIZE) ; 

Attr_List  : RCDT . Attr_Li s t_Type ( 1 . . ATTR  SIZE) ; 

Start_Time  : CALENDAR. time;  ~ 

Finish_Time  : CALENDAR. time; 

Results  : array ( 1 .. RESULT  SIZE)  of  Result  Type; 

Out file  : file_type; 

begin 

RODBCP . Load_Comps ( "rodbcomp . dat" ) ; 

Length  :■  1; 

Addr_List ( 1 ) : - 0 ; 

Number  OfJTimes  :»  1000; 
for  I In  1. .RESULT_SIZE  loop 
StartJTime  CALENDAR. clock; 

for  J in  1. ,Number_Of_Times  loop  — no  priority  raise/ lower  no  semaphores 
RODBCP . Read_Attrs ( Addr_List , Length , Attr_List ) ; 
end  loop ; 

FinishJTime  CALENDAR. clock ; 

Results (I)  :«  (Number_Of_Times,  Finish_Time-Start_Time) ; 

Number_Of_Times  :■  Number_Of_Times  + 1000; 
end  loop; 

— Output  the  result  to  a file 

create (Out file,  out_file,  "rodbcompl.out", 

form»>"world=>read,  owner»>read_write") ; 
put_line (Out file,  "NO  Number_Of_Iterations  Times"); 
for  I in  1.. RESULT  SIZE  loop 

INT_IO . put (OutfTle , I,  width  »>  5); 

INT_IO.put (Outf ile,  Results (I) .Loops) ; 

FIX_IO.put (Outf ile,  Results (I) .Times) ; 
new_line( Out file) ; 
end  loop; 
close (Outf ile) ; 
exception 

when  others  *> 


put_line("Main  program  exception"); 


end  RodbtstCl; 
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Thig  is  the  writing  test  program  with  no  Premption  Control,  no  semaphores 

with  TEXT  10 , CALENDAR , SYSTEM , RODB_Component_Data_Types_Mod , RODB_Component_Mod 
use  TEXT~I0, CALENDAR, SYSTEM,  RODB_Component_Data_Types_Mod , RODB_Component_Mod 
procedure  RodbtstC2  is 

— This  program  tests  uncontested  writes  to  shared  memory 
— — Constant  definitions 
ATTR  SIZE  : constant  integer  :=  200; 

RESULT_S I Z E : constant  integer  :=  10; 

— Data  type  definition 
type  Result_Type  is  record 
Loops  : integer ; 

Times  : duration; 
end  record; 


— Package  instantiation 

package  INT 10  is  new  TEXT_I0. INTEGER_I0( integer) ; 
package  FIX_IO  is  new  TEXT_I0. FIXED_I0 (duration) ; 
package  RCDT  renames  RODB_Component_Data_Types_Mod; 
package  RODBCP  renames  RODB_Component_Mod; 


— Variable  definition 


Length 

Number  Of_Times 

Addr_Llst 

Attr_List 

Start_Time 

Finish_Time 

Results 

Out file 


integer ; 
integer; 

RCDT . Pos_List_Type ( 1 . . ATTR_SIZE) ; 

RCDT . At tr_L i s t_Type ( 1 . . ATTR_SIZE) ; 
CALENDAR . time ; 

CALENDAR . t ime ; 

array ( 1. ,RESULT_SIZE)  of  Result_Type; 
file  type; 


begin 

RODBCP . Load_Comps ( "rodbcomp . datM ) ; 

Length  : = 1; 

Addr  List(l)  0; 

Attr_List (1)  :=  (Type_ID  *>  0,  Int_Value  =>  200); 

Number  Of_Times  :*  1000; 
for  I In  1. .RESULT_SIZE  loop 
Start  Time  :«  CALENDAR. clock; 

for  J_in  1 . . Number_Of _Times  loop  — No  priority  raise/ lower  no  semaphores 
RODBCP. Write_Attrs(Addr_List,  Length,  Attr_List) ; 
end  loop; 

Finish  Time  :«  CALENDAR. clock; 

Results (I)  :«  (Number_Of_Times,  Finish_Time-Start_Time) ; 

Number_0 f _T imes  Number_Of_Times  + 1000; 

end  loop; 

— Output  the  result  to  a file 

create (Outfile,  out  file,  " rodbcomp 2 . out" , 

form->"world=>read,  owner“>read_write") ; 
put_line (Outfile,  "NO  Number_Of_Iterations  Times"); 

for  I in  1.. RESULT  SIZE  loop 

INT_IO. put (Out file,  I,  width  »>  5); 

INT_IO. put (Out file,  Results (I) .Loops) ; 

FIX_I0. put (Out file,  Results (I) .Times) ; 
new_l ine ( Outf i le ) ; 
end  loop; 
close (Outfile) ; 
exception 

when  others  => 


put_line ("Main  program  exception") ; 


end  RodbtstC2; 


t 

t 

r rrr  oooo  oooo  ttttt 

rr  r o o o o t 

r oooo  t 

r o o o o t 

r oooo  t t 

r oooo  oooo  tt 


d b 
d b 
d b 


r rrr 

oooo 

ddd 

d 

b bbb 

cccc 

oooo 

m 

m mm 

p 

ppp 

rr  r 

o 

o 

d 

dd 

bb  b 

c c 

o 

o 

mm 

m 

m 

pp 

p 

r 

o 

o 

d 

d 

b b 

c 

o 

o 

m 

m 

m 

p 

p 

r 

o 

o 

d 

d 

b b 

c 

o 

o 

m 

m 

m 

p 

p 

r 

o 

o 

d 

dd 

bb  b 

c c 

o 

o 

m 

m 

m 

pp 

p 

• • 

r 

oooo 

ddd 

d 

b bbb 

cccc 

oooo 

m 

m 

m 

p 

ppp 

. • 

P 

P 

P 


Job : r odbcomp . dat 

Date:  Sun  Apr  5 20:27:54  1992 


10 

0  100 
1 200 

2 300 

3 400 

4 500 

5 600 

6 700 

7 800 

8 900 

9 1000 

10 

0 A 

1 B 

2 C 

3 D 

4 E 

5 F 

6 G 

7 H 

8 I 

9 J 

10 

0 false 

1 false 

2 false 

3 false 

4 false 

5 false 

6 false 

7 false 

8 false 

9 false 

10 

0 100.0 
1 200.0 

2 300.0 

3 400.0 

4 500.0 

5 600.0 

6 700.0 

7 800.0 

8 900.0 

9 1000.0 


t 

t 

r rrr  oooo  oooo  ttttt 

rr  r o o o o t 

r oooo  t 

r oooo  t 

r oooo  t t 

r oooo  oooo  tt 


d 

d 

d 


r rrr 

oooo 

ddd  d 

rr  r 

o 

o 

d dd 

r 

o 

o 

d d 

r 

o 

o 

d d 

r 

o 

o 

d dd 

r 

oooo 

ddd  d 

b 

b 

b 

b bbb  cccc  oooo 

bb  b c co  o 

b b c o o 

b b c o o 

bb  b c co  o 

b bbb  cccc  oooo 


1 

11 
1 1 


m m nun  p ppp  1 

mm  m m pp  p 1 

m m m p p 1 

m m m p p 1 

m m m pp  p 1 


m m m p ppp  11111 

P 
P 
P 


Job : r odbcomp 1 . out 

Date:  Sun  Apr  5 20:24:50  1992 


NO 


Number  Of 

Iterations 

1 

1000“ 

0.08588 

2 

2000 

0.15259 

3 

3000 

0.23840 

4 

4000 
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5 
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0.39105 

6 

6000 
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7 

7000 

0.55316 

8 

8000 
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9 

9000 

0.76154 

10 
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NO 


Number  Of 

Iterations 

1 

1000 

0.07629 

2 

2000 

0.16211 

3 

3000 

0.23840 

4 

4000 

0.37061 

5 
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0.39099 

6 

6000 
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7 

7000 
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8 

8000 
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9 

9000 

0.76160 

10 

10000 
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Times 
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— This  package  provides  the  constants,  instantiated  packages,  system  calls 

— and  C functions  interfaces  to  C language  for  RODB  COMPONENT  package. 

— In  this  case  we  do  npt  need  to  make  any  C calls  so  they  have  been  commented 

— out.  This  is  system  rodbtstbl 
with  TEXT_IO,  SYSTEM; 

use  TEXT_IO,  SYSTEM; 

package  RODB_COMPONENT_DATA  _TYPES_MOD  is 


— Constants 

INT_SIZE 

CHAR_SIZE 

BOOLSIZE 

FLT_SIZE 

SHMKEY 

SEMKEY 

SHM_SIZE 

CHAR_OFFSET 

BOOLOFFSET 

FLT  OFFSET 


constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 


- 10; 
- 10; 
- 10; 
= 10; 


- 99; 

- 100; 

= INT_SIZE*4+CHAR_SIZE+BOOL_SIZE+4*FLT  SIZE; 
- INT_SIZE*4; 

= CHAR_OFFSET  + CHAR_SIZE*1; 

= BOOL_OFFSET  + BOOL_SIZE*l; 


— Data  types 

type  Attr_Type(Type_ID  : integer  :=  0)  is  record 
case  Type_ID  is 
when  0 *> 

Int_Value  : integer; 
when  1 =*=> 

Char_Value  : character; 
when  2 ■> 

Bool_Value  : boolean; 
when  3 =■> 

Flt_Value  : float; 
when  others  -> 

null; 
end  case; 
end  record; 

type  Attr_List_Type  is  array ( integer  range  <>)  of  Attr_Type; 
type  Pos_List_Type  is  array ( integer  range  <>)  of  integer; 


— Package  instantiation 

package  INT_IO  is  new  TEXT_IO. INTEGER_IO( integer) ; 
package  BOOL_IO  is  new  TEXT_I0. ENUMERATION_IO( boolean) ; 
package  FLT_IO  is  new  TEXT_I0. FLOAT_IO( float) ; 
function  FINT  is  new  system. fet ch_from_addr ess (integer) ; 
function  FCHAR  is  new  system. fetch_from_address (character) ; 
function  FBOOL  is  new  system. fetch_from_address (boolean) ; 
function  FFLT  is  new  system. f etch_f rom_address ( float) ; 
procedure  AINT  is  new  system. assign_to_address( integer) ; 
procedure  ACHAR  is  new  system. assign_to_address (character) ; 
procedure  ABOOL  is  new  system. assign_to_address (boolean) ; 
procedure  AFLT  is  new  system. assign_to_address (float) ; 

— Shared  memory  system  call  interface 

function  SHMGET (KEY  : in  integer; 

SIZE  : in  integer; 

FLAG  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SHMGET); 
pragma  INTERFACE_NAME ( SHMGET , " shmget " ) ; 
function  SHMAT ( SHMID  : in  integer; 

SHMADDR  : in  system. address; 

FLAG  : in  integer)  return  system. address; 


pragma  INTERFACE (C,  SHMAT); 

pragma  I NT  ERF AC  E_N AM E ( SHMAT , " shmat " ) ; 

function  SHMDT ( SHMADDR  : in  system. address)  return  integer; 

pragma  INTERFACE (C,  SHMDT); 

pragma  INTERFACE_NAME ( SHMDT , ” shmdt " ) ; 

function  SHMCTL ( SHMID  : in  integer; 

CMD  : in  integer; 

BUFF  : in  system. address)  return  integer; 

pragma  INTERFACE (C,  SHMCTL); 
pragma  INTERFACE_NAME( SHMCTL,  "shmctl") ; 

— Semaphore  system  call  and  C function  interface  — no  semaphores  here 

— function  SEMGET (KEY  : in  integer; 

NSEMS  : in  integer; 

FLAG  : in  integer)  return  integer; 

— pragma  INTERFACE (C,  SEMGET); 

— pragma  INTERFACE_NAME( SEMGET,  "semget"); 

— function  SEMSINIT(SEMID  : in  integer)  return  integer; 

— pragma  INTERFACE ( C , SEMSINIT) ; 

— pragma  INTERFACE_NAME( SEMSINIT,  "semsinit"); 

— function  SEMPRINT ( SEMID  : in  integer)  return  integer; 

— pragma  INTERFACE (C,  SEMPRINT); 

— pragma  INTERFACE_NAME ( SEMPRINT,  "semprint") ; 

— function  READBEG (SEMID  : in  integer)  return  integer; 

— pragma  INTERFACE (C,  READBEG) ; — no  readbeg.c 

— pragma  INTERFACE_NAME (READBEG,  "readbeg") ; 

— function  READEND (SEMID  : in  integer)  return  integer; 

— pragma  INTERFACE (C,  READEND) ; — no  readend.c 

— pragma  INTERFACE_NAME (READEND,  "readend") ; 

— function  WRITEBEG( SEMID  : in  integer)  return  integer; 

— pragma  INTERFACE (C,  WRITEBEG); 

— pragma  INTERFACE_NAME (WRITEBEG,  "writebeg");  — no  writebeg.c 

— function  WRITEEND (SEMID  : in  integer)  return  integer; 

— pragma  INTERFACE (C,  WRITEEND); 

— pragma  INTERFACE_NAME (WRITEEND,  "writeend") ; — no  writend.c  either 

— function  SEMSRMV ( SEMID  : in  integer)  return  integer; 

— pragma  INTERFACE (C,  SEMSRMV); 

— pragma  INTERFACE_NAME( SEMSRMV,  "semsrmv") ; 

end  RODB_Component_Data_Types_Mod ; 
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with  TEXT_IO , SYSTEM,  Rodb_Component_Data_Types_Mod ; 
use  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types_Mod; 
package  Rodb_Component_Mod  is 

— Package  renaming 

package  RCDT  renames  Rodb_Component_Data_Types_Mod; 

— Exception  definition 
Shm_Exception  : exception; 

Shm_Outrange  : exception; 

Sem_Exception  : exception; 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT.PosListType; 

Length  : in  integer; 

Attr_List  : in  out  RCDT.Attr_List_Type) ; 

— Write  attributes  to  RODB  components 

procedure  Write_Attrs (Addr_List  : in  RCDT . Pos_List_Type ; 

Length  : in  integer; 

Attr_List  : in  RCDT. Attr_List_Type) ; 

— Print  out  the  semaphore  values  ~ don't  need  this  now 
— procedure  Print_Sems; 

— Load  RODB  components  from  a disk  file 

procedure  Load_Comps (Filename  : in  string); 

— Save  RODB  components  to  a disk  file 

procedure  Save_Comps (Filename  : in  string); 

— Shutdown  the  RODB  components 
procedure  Shutdown_Comps ; 


end  RODB  COMPONENT  Mod; 
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with  TEXT_IO,  CALENDAR,  SYSTEM,  Rodb_Component_DataJTypes_Mod; 
use  TEXT_IO,  CALENDAR,  SYSTEM,  Rodb_Component_DataJTypes_Mod; 
package  body  Rodb_Component_Mod  is 

— In  this  program  the  calls  to  readbeg.c  and  readend.c  were  eliminated, 

— the  reason  being  that  no  semaphores  or  dynamic  priority  operations 

— were  used.  The  concept  was  to  see  what  time  it  would  take  for  1000, 

— 2000,..  5000,  etc.  unencumbered  reads  and  writes. 


— Local  variables 
Shmid  : integer; 

Shmaddr  : system. address; 
Semid  : integer ; 


— Local  subprograms 
procedure  Load_Ints (Infile  : 
procedure  Load_Chars (Infile  : 
procedure  Load_Bools (Infile  : 
procedure  Load_Flts( Infile  : 
procedure  Save_Ints (Out file  : 
procedure  Save_Chars( Out file  : 
procedure  Save_Bools(Outfile  : 
procedure  Save_Flts(Outfile  : 


in  FILEJTYPE) 
in  FILE_TYPE) 
in  FILEJTYPE) 
in  FILEJTYPE) 
in  FILEJTYPE) 
in  FILEJTYPE) 
in  FILEJTYPE) 
in  FILEJTYPE) 


— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  out  RCDT. Attr_List_Type)  is 
Temp  : system. address; 

Flag  : integer  0; 
begin 

— PREEMPTION_CONTROL . DISABLE_PREEMPTION ; 

— Flag  :=■  RCDT. READBEG (Semid) ; — don't  need  readbeg  if  no  semaphore 

— PREEMPTI0N_C0NTR0L . ENABLE_PREEMPTION ; 

— if  Flag  = -1  then 

raise  Sem_Exception; 

— end  if; 

for  I in  1.. Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr_List (I)  > RCDT.SHM_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp  Shmaddr  + system. offset (Addr_List (I) ) ; 
if  (Addr  List (I)  < RCDT . CHAR_OFFSET)  then 

Attr_Llst(I)  (Type_ID  ->  0,  Int_Value  ->  RCDT. FINT (Temp) ) ; 
elsif  (Addr_List(I)  < RCDT.BOOLOFFSET)  then 

Attr_List (I)  :■  (Type_ID  ->  1,  Char_Value  =>  RCDT. FCHAR (Temp) ) ; 
elsif  (Addr_List (I)  < RCDT . FLT_OFFSET)  then 

Attr_List (I)  :«  (Type_ID  =>  2,  Bool_Value  =>  RCDT. FBOOL (Temp) ) ; 

Attr_List (I)  :*  (Type_ID  =>  3,  Flt_Value  =>  RCDT. FFLT (Temp) ) ; 
end  if; 
end  loop; 

— delay  10.0; 

— PREEMPTION_CONTROL . DISABLE_PREEMPTION ; 

— Flag  :*  RCDT. READ END ( Semid ) ; — don't  need  readend  if  no  semaphore 

— PREEMPTION_CONTROL . ENABLE_PREEMPTION ; 

— if  Flag  - -1  then 

— raise  Sem_Exception; 

— end  if; 
end  Read  Attrs; 


— Write  attributes  to  RODB  components 

procedure  Write_Attrs(Addr_List  : in  RCDT . Pos_List_Type ; 

Length  : in  integer; 

Attr_List  : in  RCDT.Attr_List_Type)  is 

Temp  : system. address; 

Flag  : integer:*  0; 
begin 

— PREEMPTI0N_C0NTR0L . DISABLE_PREEMPTION ; 

— Flag  :■  RCDT.WRITEBEG(Semid) ; — Don't  need  if  no  semaphores 

— PREEMPTI0N_C0NTR0L.ENABLE_PREEMPTI0N; 

— if  Flag  * -1  then 

— raise  Sem_Exception; 

— end  if; 

for  I in  1 . . Length  loop 

if  (Addr_List(I)  < 0)  or  ( Addr_List (I)  > RCDT.SHM_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp  :■  Shmaddr  + system. offset (Addr_List (I) ) ; 
if  (Addr_List (I)  < RCDT . CHAR_OFFSET)  then 
RCDT . AINT (Temp , Attr_List (I) . Int_Value) ; 
elsif  (Addr_List (I)  < RCDT . BOOL_OFFSET)  then 
RCDT . ACHAR (Temp , Attr_List (I) . Char_Value) ; 
elsif  (Addr_List (I)  < RCDT . FLT_OFFSET)  then 
RCDT . ABOOL (Temp , Attr_List (I) . Bool_Value) ; 
else 

RCDT. AFLT( Temp,  Attr_List(I) .Flt_Value) ; 
end  if; 
end  loop; 

— delay  10. 0; 

— PREEMPTION_CONTROL.DISABLE_PREEMPTION; 

— Flag  :*  RCDT.WRITEEND(Semid) ; — — don't  need  for  no  semaphore 

— PREEMPT I ON_CONTROL . ENABLE_PREEMPTION ; 

— if  Flag  - -1  then 

— raise  Sem_Exception; 

— end  if; 
end  Write_Attrs; 

— Print  out  the  semaphore  values  — but  now  there  aren't  any 

— procedure  Print_Sems  is 

Flag  : integer; 

— begin 

Flag  RCDT.SEMPRINT(Semid) ; 
if  Flag  - -l  then 

raise  Sem_Exception; 
end  if; 

— end  Pr int_Sems ; 

— Load  RODB  Components  from  a disk  file. 

— Thd  structure  of  disk  file  is  as  following: 

Number_Of_Integers 

— Positionl  Integerl 

— Position2  Integer2 

• • • 

Number_Of_Characters 

— Positionl  Characterl 

— Position2  Character2 

«a.«KP  • • • 

Number  Of  Booleans 


Positionl  Booleanl 
Position2  Boolean2 
""  * • • 

— Number_Of_Floats 

— Positionl  Floatl 

— Position2  Float2 

“ ” • • • 

procedure  Load_Comps (Filename  : in  string)  is 
Infile  : FILE_TYPE; 

Temp  : system. address; 

Flag  : integer; 

begin 

open(Infile,  in_file,  Filename); 

— Initialize  RODB  Integer  Component 
for  I in  1 . .RCDT. INT_SIZE  loop 

Temp  :*  Shmaddr  + system. offset ( (1-1) *4) ; 

RCDT. AINT( Temp,  0) ; 
end  loop; 

Load_Ints( Infile)  ; 

— Initialize  RODB  Character  Component 
for  I in  1. .RCDT.CHAR_SIZE  loop 

Temp  :«  Shmaddr  + system. offset (RCDT. CHAR_OFFSET  + 1-1) ; 
RCDT. ACHAR (Temp,  'X'); 
end  loop; 

Load_Chars(Inf ile) ; 

— Initialize  RODB  Boolean  Component 
for  I in  1. .RCDT.BOOL_SIZE  loop 

Temp  :*  Shmaddr  + system. offset (RCDT. BOO L_OFFSET  + 1-1) ; 
RCDT. ABOOL( Temp,  true); 
end  loop; 

Load_Bools (Infile) ; 

— Initialize  RODB  Float  Component 
for  I in  1 . . RCDT . FLT_SI ZE  loop 

Temp  :=  Shmaddr  + system. offset (RCDT. FLT_OFFSET  + (I-l)*4); 
RCDT. AFLT( Temp,  0.0); 
end  loop; 

Load_Flts (Infile) ; 
close (Inf ile) ; 

Flag  :«  RCDT.SEMSINIT(Semid) ; 

— if  Flag  - -1  then 

raise  Sem_Exception; 
end  if; 

exception 

when'  name_error  => 

put_lineCFile  cannot  be  opened."); 
put_line( "Loading  components  fails!"); 
when  data_error  | end_error  => 

put_line("File  format  is  incompatible."); 
put_line( "Loading  components  fails!"); 

— when  Sem_Exception  ■> 

— put_line(" Semaphore  cannot  be  initialized."); 

— raise  Sem_Exception; 


when  others  => 

put_line( "Unknown  exception."); 
put_line( "Loading  components  fails!"); 
end  Load_Comps ; 

— Save  RODB  Components  to  a disk  file 

— The  structure  of  the  disk  file  is  as  following: 

Number_Of_Integers 
Positionl  Integerl 
Position2  Integer2 
**  **  • • • 

Number_Of_Characters 
Positionl  Characterl 
Position2  Character 2 
“ • « • 

Number_Of_Booleans 
Positionl  Booleanl 

— Position2  Boolean2 

• mm 

Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 
“ “ • • • 

procedure  Save_Comps (Filename  : in  string)  is 
Outfile  : FILEJTYPE; 
begin 

if  Filename  /-  ""  then 

create (Outfile,  out_file.  Filename, 

form«>"world«>read,  owner => read  write") ; 

Save_Ints (Outfile) ; 

Save_Chars (Outfile) ; 

Save_Bools (Outfile) ; 

Save_Flts (Outfile) ; 
close (Outfile) ; 
else 

Save_Ints (TEXT_IO. standard_output) ; 

Save_Chars (TEXT_IO. standard_output) ; 

Save_Bools (TEXT_IO. standard_output) ; 

Save  Fits (TEXT  10. standard  output); 
end  if J 
exception 

when  constraint_error  *> 

put_line("RODB  Components  data  collapsed."); 
put_line( "Saving  components  fails!"); 
when  others  =•> 

put_l  ine  ( "Unlcnown  exception . " ) ; 
put_line(" Saving  components  fails!"); 
end  Save_Comps ; 

— Shutdown  RODB  Components 
procedure  Shutdown_Comps  is 

Flag  : integer ; 
begin 

Flag  :=  RCDT . SHMDT ( Shmaddr ) ; 
if  Flag  - -1  then 

raise  Shm_Exception; 
end  if; 

Flag  RCDT.SHMCTL(Shmid,  0,  system. null  address); 
if  Flag  - -l  then 
raise  Shm_Exception; 


end  if; 

— Flag  :*  RCDT. SEMSRMV(Semid) ; 

— if  Flag  * -1  then 

raise  Sem_Exception; 

— end  if; 

end  Shutdown_Comps; 

pragma  page; 

— Load  all  the  integers  from  a disk  file  to  RODB  Integer  Component 
procedure  Load  Ints( Infile  : in  FILE_TYPE)  is 

Length  : Integer; 

Temp_Pos  : integer ; 

Temp_Int  : integer ; 

Temp_Addr  : system. address ; 
begin 

INT_IO.get (Inf ile.  Length); 

skip_line( Infile) ; 

for  I in  1 . . Length  loop 

INT_IO.get (Inf ile,  Temp_Pos) ; 

INT_IO.get(Infile,  Temp_Int) ; 
skip_line(Inf ile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. INT_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if ; 

Temp_Addr  :»  Shmaddr  + system. offset (Temp_Pos*4) ; 

RCDT . AINT (Temp_Addr , Temp_Int) ; 
end  loop; 
end  Load_Ints; 

— Load  all  the  charaters  from  a disk  file  to  RODB  Character  Component 
procedure  Load  Chars (Infile  : in  FILE_TYPE)  is 

Length  : Integer; 

Temp_Pos  : integer ; 

Temp_Char  : character ; 

Temp_Addr  : system. address; 
begin 

INT_I0. get (Infile,  Length); 

skip_line( Infile) ; 

for  I in  1 . . Length  loop 

INT_IO.get (Inf ile,  Temp_Pos) ; 

get(Infile,  Temp_Char) ; — Skip  a space 

get(Infile,  Temp_Char) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.CHAR_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :■»  Shmaddr  + system. offset(RCDT.CHAR_OFFSET+Temp_Pos) ; 
RCDT . ACHAR ( Temp_Addr , Temp_Char) ; 
end  loop ; 
end  Load_Chars; 

— Load  all  the  booleans  from  a disk  file  to  RODB  Boolean  Component 
procedure  Load  Bools (Infile  : in  FILE_TYPE)  is 

Length  : Integer; 

Temp_Pos  : integer ; 

Temp_Bool  : boolean; 

Temp_Addr  : system. address; 
begin 

INT_IO . get ( Infile , Length); 


skip_line(Inf ile) ; 
for  I in  1.. Length  loop 

INT_IO.get (Inf ile,  Temp_Pos) ; 

BOOL_IO. get (Infile,  Temp_Bool) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.BOOL_SIZE-l)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :-  Shmaddr  + system. offset (RCDT.BOOL_OFFSET+Temp_Pos)  ; 
RCDT . ABOOL ( Temp_Addr , Temp_Boo 1 ) ; 
end  loop; 
end  Load_Bools; 

— Load  all  the  floats  from  a disk  file  to  RODB  Float  Component 
procedure  Load  Fits (Infile  : in  FILE_TYPE)  is 

Length  : Tnteger ; 

Temp_Pos  : integer ; 

Temp_Flt  : float; 

Temp_Addr  : system. address; 
begin 

INT_IO . get ( Infile , Length); 

skip_line (Infile) ; 

for  I in  1.. Length  loop 

INT_I0 . get (Infile,  Temp_Pos ) ; 

FLT_IO . get ( Infile , Temp_Flt ) ; 
skip_line( Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.FLT_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :■  Shmaddr  + system. offset (RCDT. FLT  OFFSET+Temp  Pos*4) ; 
RCDT . AFLT ( Temp_Addr , Temp_F 1 t ) ; 
end  loop; 
end  Load_Flts; 

pragma  page; 

— Save  all  the  integers  from  RODB  Integer  Component  to  a disk  file 
procedure  Save_Ints(Outfile  : in  FILEJTYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Integers  is:  ") ; 

Int_IO.put (Outfile,  RCDT.INT_SIZE) ; 
new_line(Outfile) ; 
for  I in  1. .RCDT.INT_SIZE  loop 
put (Outfile,  "Integer  number  "); 

Int_IO. put (Outfile,  I-l,  width  =>  5); 
put (Outfile,  ":"); 

Temp_Addr  Shmaddr  + system. offset( (1-1) *4) ; 

Int_IO. put (Outfile,  RCDT.FINT(TempAddr) ) ; 
new_line (Outfile) ; 
end' loop; 
end  Save_Ints; 

— Save  all  the  characters  from  RODB  Character  Component  to  a disk  file 
procedure  Save_Chars (Outfile  : in  FILEJTYPE)  is 

Temp_Addr  : system. address; 
begin 

put (Outfile,  "Number  Of  Characters  is:  "); 

Int_IO. put (Outfile,  RCDT.CHAR_SIZE) ; 
new_line (Outfile) ; “ 


for  I in  1. .RCDT.CHAR_SIZE  loop 

put(Outfile,  "Character  number  ") ; 

Int_IO.put (Outf ile,  1-1,  width  =>  5); 
put ( Out file, 

Temp  Addr  :■  Shmaddr  + system. offset (RCDT.CHAR_OFFSET  + 1-1) ; 
put ( Out  file,  RCDT . FCHAR ( Temp_Addr ) ) ; 
new_line( Out file) ; 
end  loop; 
end  Save_Chars; 

— Save  all  the  booleans  from  RODB  Boolean  Component  to  a disk  file 
procedure  Save_Bools (Outf ile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Booleans  is:  ") ; 

Int_IO. put (Outf ile,  RCDT.BOOL_SIZE) ; 
new_line( Out file) ; 
for  I in  1. .RCDT.BOOL_SIZE  loop 
put(Outfile,  "Boolean  number  ") ; 

Int_IO. put (Out file,  1-1,  width  =>  5); 
put (Outf ile,  ":"); 

Temp_Addr  Shmaddr  + system. offset (RCDT. BOOL_OFFSET  + 1-1) ; 
Bool_IO . put (Outf ile , RCDT . FBOOL (Temp_Addr ) ) ; 
new_line( Out file) ; 
end  loop; 
end  Save_Bools; 

— Save  all  the  floats  from  RODB  Float  Component  to  a disk  file 

procedure  Save_Flts( Out file  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Floats  is  "); 

Int_IO. put (Out file,  RCDT. FLT_SIZE) ; 
new_line (Outf ile) ; 
for  I in  1 . . RCDT . FLT_SI  ZE  loop 
put(Outfile,  "Float  number  ") ; 

Int_IO.put (Outf ile,  1-1) ; 
put (Outf ile,  ":"); 

Temp_Addr  Shmaddr  + system. offset (RCDT. FLT_OFFSET  + (I-l)*4); 
Flt_IO . put (Outf ile , RCDT . FFLT (Temp_Addr ) ) ; . 
new_line (Outf ile) ; 
end  loop; 
end  Save_Flts; 

pragma  page; 

begin 

Shmid  RCDT. SHMGET ( RCDT. SHMKEY,  RCDT. SHM_SIZE,  1023); 
if  Shmid  » -1  then 
raise  Shm_Exception; 
end  if; 

Shmaddr  :*  RCDT. SHMAT( Shmid,  system. null_address,  0); 

— if  Shmaddr  * system. null_address  then 

raise  Shm_Exception;  ” 

— end  if; 

— semid  :»  RCDT. SEMGET (RCDT. SEMKEY,  3,  1023); 

— if  Semid  - -1  then 

— raise  Sem_Exception; 

— end  if; 

end  Rodb_Component_Mod ; 
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Job: 

readbeg . c 

Date 

: Sun  Apr  5 20:23:31  1992 

/*  File:  readbeg.c  This  is  read  begin  subroutine  to  set  reading  protection  */ 
/*  for  this  test  this  program  has  been  modified  to  do  nothing  */  ' 

/include  <sys/types.h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 


/*  The  operations  on  semaphores  */ 
struct  sembuf  RREAD_S TART  * { 0,  1,  0>; 

struct  sembuf  RWAIT_NO_WRITE_LOCK  - { 1,  0,  0}; 

struct  sembuf  RWAIT_NO_WRITE_DESIRE  - { 2,  0,  0); 

int  readbeg(semid) 
int  semid; 

{ 

struct  sembuf  one_of_n_readers [ 5 ] ; /*  Three  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid_t  my_tid; 

int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 

/*  my_tid  - getstid(); 
my_prio  - getprio(getpid() ) ? 

f ast_setpr io (my_tid , 31);  */  /*  No  priority  operations  here  */ 

/*  Perform  three  semaphore  operations  *//*  Also  no  semops  here  */ 

/*  one_of_n_readers [ 0 ) - RWAIT_N0_WRITE_L0CK;  */  /*  Wait  for  no  more  writer  * 

/*  one_of_n_readers[l]  - RWAIT_NO_WRITE_DESIRE; */  /*  Wait  for  no  more  writer  * 

/*  one_of _n_readers [ 2 ] - RWAIT_NO_WRlTE_LOCK;  */  /*  Wait  for  no  more  writer  * 

/*  one_of_n_readers[3]  - RWAIT_NO_WRITE_DESIRE ; */  /*  Wait  for  no  more  writer  * 

/*  one_of_n_readers[4]  - RREAD_START;  */  /*  Prevent  writer  in  */ 

/*  flag  - semop( semid,  one_of _n_reader s , 5) ; */  /*  Lock  the  critical  section  * 

/*  if  (flag  — -1)  { 

perror ("readbeg  fails:  "); 

} */ 

/*  Lower  the  priority  to  the  normal  */ 

/*  fast_setprio(my_tid,  my_prio);*/  /*  No  priority  operations  for  this  test  */ 
return  0; 
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Job : readend . c 

Date:  Sun  Apr  5 20:23:38  1992 


/*  File:  readend.c  This  is  read  end  subroutine  to  reset  protection  */ 
/*  for  this  test  this  program  has  been  modified  to  do  nothing  */ 


/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 


/*  The  operations  on  the  semaphore  */ 
struct  sembuf  RREAD_END  = { o,  -1,  0>; 

int  readend(semid) 
int  semid; 

{ 

int  flag; 
void  perror ( ) ; 
tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */  /*  No  priority  ops  */ 
/*  my_tid  * getstid(); 
my_prio  ■ getprio(getpid() ) ; 

fast_setprio(my_tid,  31);  */  /*  Commented  out  */ 

/*  Perform  the  semaphore  operation  */  /*  No  semops  either  */ 

/*  flag  - semop (semid,  &RREAD  END,  1);  */  /*  Unlock  critical  section 

/*  if  (flag  =-  -1)  { 

perror ("readend  fails:  "); 

> */ 

/*  Lower  the  priority  to  the  normal  */ 

/*  fast_setprio(my_tid,  my_prio) ; */  /*  Commented  out  */ 
return  flag; 

> 
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Job:  vritebeg.c 

Date:  Sun  Apr  5 20:23:47  1992 


/*  File:  writebeg.c  This  is  write  begin  subroutine 
/*  in  this  directory  this  program  has  been  modified 
/include  <sys/types.h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 


to  set  protection  */ 
to  do  nothing  */ 


/*  The  operations  on  semaphores  */ 
struct  sembuf  WWAIT_NO_READERS  = 
struct  sembuf  WREAD_START  = 
struct  sembuf  WWRITE_LOCK  = 
struct  sembuf  WWRITE_DESIRE  > 
struct  sembuf  WIN  PROGRESS  WRITE  - 


{ 

0, 

Or 

0} 

{ 

0, 

1, 

0} 

{ 

1, 

1, 

0} 

{ 

2, 

1, 

0} 

{ 

2, 

-1, 

0} 

int  writebeg(semid) 
int  semid; 

{ 

struct  sembuf  sole_writer[4] ; f*  Four  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid_t  my_tid; 

int  my_prio; 


/*  Raise  the  priority  to  prevent  the  preemption  */ 

/*  my_tid  - getstidQ  ; 

my_prio  - getprio(getpid() ) ; 

fast_setprio(my_tid,  31);  */  /*  Eliminate  priority  operations  */ 

/*  Make  write  request  by  doing  a semaphore  operation  */ 

/*  flag  - semop( semid,  &WWRITE  DESIRE,  1); 
if  (flag  — -1)  { 

perror ( "Write-Request  in  writebeg  fails:  ") ; 
return  flag; 

> */ 


/*  Perform  four  semaphore  operations  */  /*  Semops  also  eliminated  */ 

/*  sole_wr iter [ 0 ] - WWAIT_NO_READERS ; */  /*  Wait  for  no  more  readers  */ 

/*  sole_writer[l]  = WWRITE_LOCK;*/  /*  preventing  succeeding  readers  */ 

/*  sole_writer ( 2 ] - WREAD_START ; * / /*  preventing  succeeding  writers  */ 

/*  sole_wr iter [ 3 ] - WIN_PROGRESS_WRITE;  */  /*  Cancel  the  write-request  */ 

/*  flag  - semop( semid,  sole  writer,  4);*/  /*  Lock  the  critical  section  */ 

/*  if  (flag  — -1)  { 

perror ( "Wr ite_Start  in  writebeg  fails:  ") ; 

} */ 

/*  Lower  the  priority  to  the  normal  */ 

/*fast_setprio(my_tid,  my_prio) ;*//*  no  priority  operations  */ 

return  0; 

> 
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Job:  vriteend.c 

Date:  Sun  Apr  5 20:23:56  1992 


/*  File:  vriteend.c  This  is  write  end  subroutine  to 
/*  in  this  directory  this  program  has  been  modified 
/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 


reset  write  protection 
to  do  nothing  */ 


*/ 


/*  The  operations  on  semaphores  */ 
struct  sembuf  WREAD_END  = { o,  -1,  0}; 

struct  sembuf  WWRITE_UNLOCK  - { 1,  -1,  0>; 

int  writeend(semid) 
int  semid; 

{ 

struct  sembuf  sole_writer [2] ; /*  Two  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid_t  my_tid; 

int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 

/*  my_tid  - getstid(); 

myjprio  - getprio(getpid() ) ; 
fast_setprio(my_tid,  31); 

*/  /*  no  priority  operations  for  this  test  */ 

/*  Perform  the  semaphore  operation  */  /*  No  semaphore  ops  either  */ 

/*  sole_wr iter [ 0 ] = WREAD_END;  */  /*  Allow  writer  in  */ 

/*  sole_wr iter [ 1 ] » WWRITB_UNLOCK;  */  /*  Allow  reader  in  */ 

/*  flag  - semop ( semid , sole_writer,  2);*/  /*  Unlock  critical  section  */ 

/*  if  (flag  — -1)  { 

perror (N writ eend  fails:  ") ; 

} */ 

/*  Lower  the  priority  to  the  normal  */ 

J*  fast_setprio(my_tid,  my_prio) ; */  /*  Don't  lower  what  hasn't  been  raised*/ 
return  flag; 

> 
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Job:  semsinit.c 

Date:  Sun  Apr  5 20:24:10  1992 


/♦File:  semsinit. c This  is  semaphore  init  subroutine  to  initialize  semaphores* 
/include  <sys/types.h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semsinit (semid) 
int  semid; 

{ 

short  initarray [ 3 ] ; 
int  flag; 
void  perror ( ) ; 

initarray [0]  - initarray[l]  * initarray [2]  - 0; 
flag  * semctl (semid,  3,  SETALL,  initarray); 
if  (flag  ==  -l)  { 

perror ("semsinit  fails:  "); 

> 

return (flag) ; 
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Job:  semprint.c 

Date:  Sun  Apr  5 20:24:21  1992 


/‘File: semprint. c This  is  semaphore  print  subroutine  to  print  semaphore  values* 
/include  <sys/types.h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semprint (semid) 
int  semid; 

{ 

short  outarray [ 3 ] ; 
int  flag; 
void  perror ( ) ; 
int  i; 

flag  * semctl (semid,  3,  GETALL,  outarray); 
if  (flag  — -1)  { 

perror ("semprint  fails:  ") ; 

> 

for  (i«0;  i<3;  ++i)  { 

printf ("Semaphore  %d  has  the  value  of  %d\n",  i,  outarray ( i ]) ; 

> 

return (flag) ; 
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Job:  semsrmv. 

Date : Sun  Apr 


5 20:24:38  1992 


c 


/*  File:  semsrmv.c  This  is  semaphore  remove  subroutine  to  remove  semaDhores  */ 
/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semsrmv(semid) 
int  semid; 

{ 

int  flag; 
void  perror ( ) ; 

flag  * semctl(semid,  3,  IPC_RMID,  0) ; 
if  (flag  ==  -1)  { 

perror ("semsrmv  fails:  H); 

> 

return (flag) ; 


Copies  of  this  publication  have  been  deposited  with  the  Texas  State  Library  in 
compliance  with  the  State  Depository  Law. 
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The  RICIS  Concept 


The  University  of  Houston-Clear  Lake  established  the  Research  Institute  for 
Computing  and  Information  Systems  (RICIS)  in  1986  to  encourage  the  NASA 
Johnson  Space  Center  (JSC)  and  local  industry  to  actively  support  research 
in  the  computing  and  information  sciences.  As  part  of  this  endeavor,  UHCL 
proposed  a partnership  with  JSC  to  jointly  define  and  manage  an  integrated 
program  of  research  in  advanced  data  processing  technology  needed  for  JSC’s 
main  missions,  including  administrative,  engineering  and  science  responsi- 
bilities. JSC  agreed  and  entered  Into  a continuing  cooperative  agreement 
with  UHCL  beginning  in  May  1986,  to  jointly  plan  and  execute  such  research 
through  RICIS.  Additionally,  under  Cooperative  Agreement  NCC  9-16, 
computing  and  educational  facilities  are  shared  by  the  two  Institutions  to 
conduct  the  research. 

The  UHCL/ RICIS  mission  is  to  conduct,  coordinate,  and  disseminate  research 
and  professional  level  education  in  computing  and  Information  systems  to 
serve  the  needs  of  the  government,  industry,  community  and  academia. 
RICIS  combines  resources  of  UHCL  and  its  gateway  affiliates  to  research  and 
develop  materials,  prototypes  and  publications  on  topics  of  mutual  interest 
to  its  sponsors  and  researchers.  Within  UHCL,  the  mission  is  being 
implemented  through  interdisciplinary  involvement  of  faculty  and  students 
from  each  of  the  four  schools:  Business  and  Public  Administration,  Educa- 
tion, Human  Sciences  and  Humanities,  and  Natural  and  Applied  Sciences. 
RICIS  also  collaborates  with  industry  in  a companion  program.  This  program 
is  focused  on  serving  the  research  and  advanced  development  needs  of 
industry. 

Moreover,  UHCL  established  relationships  with  other  universities  and  re- 
search organizations,  having  common  research  interests,  to  provide  addi- 
tional sources  of  expertise  to  conduct  needed  research.  For  example,  UHCL 
has  entered  into  a special  partnership  with  Texas  A&M  University  to  help 
oversee  RICIS  research  and  education  programs,  while  other  research 
organizations  are  involved  via  the  “gateway"  concept 

A major  role  of  RIC  IS  then  is  to  find  the  best  match  of  sponsors,  researchers 
and  research  objectives  to  advance  knowledge  in  the  computing  and  Informa- 
tion sciences.  RICIS,  working  jointly  with  its  sponsors,  advises  on  research 
needs,  recommends  principals  for  conducting  the  research,  provides  tech- 
nical and  administrative  support  to  coordinate  the  research  and  integrates 
technical  results  into  the  goals  of  UHCL,  NASA/JSC  and  industry. 


Data  Management  Systems 

(DMS) 

Complex  Data  Types  Study 

APPENDICES 

TO 

FINAL  REPORT 


VOL  3 OF  3 

APPENDICES  D (1-3)  & E 


Appendix  D-l 


Concurrent  (Competing) 
Reader  and  Writer  Preformance  Test 

Full  Protection  of  Semaphores  and  RODB  Component. 


t 

t 

r rrr 

oooo 

oooo 

ttttt 

rr  r 

o o 

o o 

t 

r 

o o 

o o 

t 

r 

o o 

o o 

t 

r 

o o 

o o 

t t 

r 

oooo 

oooo 

tt 

d 

d 

d 

r rrr 

eeee 

aaaa 

ddd  d 

m m nun 

eeee 

rr  r 

e e 

a 

d dd 

mm  m m 

e e 

r 

eeeeee 

aaaaa 

d d 

m m m 

eeeeee 

r 

e 

a a 

d d 

m m m 

e 

r 

e e 

a aa 

d dd 

• m m m 

e e 

r 

eeee 

aaaa  a 

ddd  d 

• m m m 

eeee 

Job:  read. me 

Date : Sat  Apr 

11  23:09:58  1992 

THIS  IS  A TEST  OF  CONCURRENT  (COMPETING)  READERS  AND  WRITERS. 

THERE  ARE  THREE  TASKS  RUNNING  IN  THIS  SYSTEM:  TWO  READERS  AND  ONE  WRITER 
THEY  ARE  ACCESSING  THE  RODB  COMPONENT  WHICH  IS  PROTECTED  BY  A MECHANISM 
IN  RODBTSTD1,  ALL  THE  TASKS  HAVE  THE  SAME  PRIORITIES.  THE  RESULTS  ARE  IN 
FILES  RODBCOMP1 .OUT  ( RODBCOMP 1 1 . OUT  AND  RODBCOMP12 . OUT) . THESE  RESULTS 
CORRESPOND  TO  THE  INPUT  FILES  RODBCOMP1.IN  (RODBCOMP 11 . IN  AND  RODBCOMP12 . IN) 

This  directory  stores  all  the  files  to  build  up  RODB  "attribute”  components. 
The  protection  mechanism  is  that  locking  is  set  at  the  RODB  level.  During  the 
lock  setting,  there  is  prevention  of  preemption.  This  is  done  inside  the 
C function  by  using  the  fast_setprio  system  call.  There  is  only  one  set  of 
three  UNIX  semaphores  in  the  whole  system.  Before  actual  reading,  a set  of  fiv 
semaphore  operations  are  imposed  on  the  semaphores.  After  a read  completes  one 
semaphore  operation  is  imposed  on  a semaphore.  Before  actually  writing, 
there  are  two  levels  of  semaphore  operations:  write-desire  and  write-lock. 

For  write-desire  one  semaphore  operation  is  imposed  (test&set)  on  a semaphore. 
Once  the  read- lock  semaphore  is  unlocked,  (i.e.  last  reader  exits) , then  a 
wr^er  can  enter  and  lock  out  all  new  readers  and  any  other  following  writer. 
Write-lock  imposes  a set  of  four  semaphore  operations  on  the  semaphores. 

A^ter  actual  writing,  a set  of  two  semaphore  operations  are  imposed  on  the 
semaphores  (i.e.  unlock  for  readers  or  another  writer).  This  system  gives 
preferences  to  writers  but  readers  actually  reading  lock  out  any  writers 
that  are  waiting. 
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Job : rodbtstDl . ada 

Date:  Sat  Apr  11  22:20:04  1992 


— This  is  the  concurrent  reading  and  writing  test  program  with  default  priori 

TEXT 10 , CALENDAR , SYSTEM,  RODB Component Data Types , RODB  Component* 

use  TEXT_IO , CALENDAR,  SYSTEM,  RODB  Component  Data  Types,  RODB  Component* 
with  RODB_Test_Datal ; ” ~ ~ 

procedure  RodbtstDl  is 

— Constant  definitions 

ATTR_SIZE  : constant  integer  : 

NUMBER_0F_TIMES1  : constant  integer  : 

NUMBER_0F_TIMES2  : constant  integer  : 

NUMBER_0F_TIMES3  : constant  integer  : 

— Package  instantiation 

package  INT_I0  is  new  TEXT_I0. INTEGER_I0( integer ) ; 
package  FIX_I0  is  new  TEXT_I0. FIXED_I0 (duration) ; 
package  RCDT  renames  RODB_Component_Data_Types; 
package  RODBCP  renames  RODB_Component ; 

— task  declaration 
task  Readerl  is 

entry  Finish; 
end  Readerl; 
task  Reader2  is 
entry  Finish; 
end  Reader2 ; 
task  Writer  is 
entry  Finish; 
end  Writer; 

— Variable  definition 
Start_Timel  : CALENDAR. time; 

Start_Time2  : CALENDAR. time; 

Start_Time3  : CALENDAR. time; 

Finish_Timel  : CALENDAR. time; 

Finish_Time2  : CALENDAR. time; 

Finish_Time3  : CALENDAR. time; 

Result 1 : duration; 

Result2  : duration; 

Result3  : duration; 

Addr_Listl  ; RCDT . Pos_List_Type ( 1 . . ATTR_SIZE) 

Addr_List2  : RCDT . Pos_List_Type ( 1 . . ATTR_SI ZE) 

Addr.ListS  : RCDT.Pos_List_Type(l. ,ATTR_SIZE) 

Attr_Listl  : RCDT. Attr_List_Type ( 1. .ATTR  SIZE) 

Attr_List2  : RCDT . Attr_List_Type ( 1 . . ATTR_SIZE) 

Attr_List3  : RCDT . Attr_List_Type ( 1 . . ATTR  SIZE) 

Lengthl  : integer  :■  1; 

Length2  : integer  : - 1; 

Length3  : integer  : - l; 

Outfile  : file_type; 

— The  body  of  task  readerl 
task  body  Readerl  is 
begin 

Start_Timel  CALENDAR. clock ; 
for  I in  1. .NUMBER_0F_TIMES1  loop 

RODBCP. Read_Attrs(Addr_Listl,  Lengthl,  Attr  Listl) ; 
end  loop; 

Finish_Timel  CALENDAR. clock; 

Resultl  :»  Finish_Timel  - Start_Timel; 


* (0,  other s->0) ; 

■ (0,  others=>0) ; 

■ (0,  others*">0)  ; 

“ ( (0,200) ,others=>( 0,200) ) 

* ( (0, 200) ,others=> (0, 200) ) 
=■  ((0,200)  ,others=>(0, 200) ) 


* 200; 

* RODB_Test_Datal . Number_Of_Timesl ; 
= RODB_Test_Dat a 1 . Number_0f _T imes  2 ; 
» RODB_Test_Datal . Number_0f  Times3 ; 


accept  Finish; 
exception 

when  others  => 

put_line ("Task  Readerl  has  an  exception."); 
end  Readerl; 

— The  body  of  task  reader2 
task  body  Reader2  is 
begin 

Start_Time2  : = CALENDAR . clock ; 
for  I in  1 . . NUMBER_0F_TIMES2  loop 

R0DBCP.Read_Attrs(Addr_List2,  Length2,  Attr_List2) ; 
end  loop; 

Finish_Time2  : = CALENDAR. clock; 

Result2  :=  Finish_Time2  - Start_Time2 ; 

accept  Finish; 
exception 

when  others  => 

put_line("Task  Reader2  has  an  exception."); 
end  Reader 2 ; 

— The  body  of  task  writer 
task  body  Writer  is 
begin 

Start_Time3  : = CALENDAR. clock; 
for  I in  1 . . NUMBER_0F_TIMES3  loop 

RODBCP . Wr ite_Attrs ( Addr_List3 , Length3 , Attr_List 3 ) ; 
end  loop; 

Finish_Time3  CALENDAR. clock; 

Result3  :=  Finish_Time3  - Start_Time3; 

accept  Finish; 
exception 

when  others  => 

put_line("Task  Writer  has  an  exception."); 
end  Writer; 

begin 

— Terminate  gracefully 
Readerl . Finish ; 

Reader2 . Finish ; 

Writer .Finish ; 

— Write  out  the  results 

create (Outfile,  out_file,  "rodbcompl . out" , 

f orm->"world=>read,  owner->read_wr ite" ) ; 
put_line (Outfile,  "Task  Number_Of_Iterations  Times") ; 

put(Outfile,  "Readerl  ") ; 

INT_IO. put (Outfile,  NUMBER_OF_TIMES 1 ) ; 

FIX_IO. put (Outfile,  Result 1) ; 

new_line (Outfile) ; 

put (Outfile,  "Reader2  ") ; 

INT_IO . put (Outf i le , NUMBER_0F_TIMES2 ) ; 

FIX_IO. put (Outfile,  Result2) ; 
new_line (Outfile) ; 
put(Outfile,  "Writer  "); 

INT_IO . put (Outf ile , NUMBER_OF_TIMES 3 ) ; 

FIX_IO. put (Outfile,  Result3) ; 


new_line(Outfile) 
close (Outfile) ; 


end  RodbtstDl; 
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— This  package  provides  the  constants,  instantiated  packages,  system  calls 

— and  C functions  interfaces  to  C language  for  RODB  COMPONENT  oackaae 
with  TEXT_IO , SYSTEM; 

use  TEXT_IO,  SYSTEM; 

package  RODB_COMPONENT  DATA  TYPES  is 


— Constants 
INT_SIZE  : 

CHAR_SIZE  : 

BOOL_SIZE  : 

FLT_SIZE  : 

SHMKEY  : 

SEMKEY  : 

SHM_SIZE  : 

CHAR_OFFSET  : 

BOOL_OFFSET  : 

FLT_OFFSET  : 

— Data  types 
type  Attr_Type(Type_ID  : integer  :=  0)  is  record 

case  Type_ID  is 
when  0 => 

Int_Value  : integer; 
when  1 «> 

Char_Value  : character; 
when  2 »> 

Bool_Value  : boolean; 
when  3 *> 

Flt_Value  : float; 
when  others  => 
null; 
end  case; 
end  record; 

type  Attr_List_Type  is  array ( integer  range  <>)  of  Attr  Type; 
type  Pos_List_Type  is  array ( integer  range  <>)  of  integer; 

— Package  instantiation 

package  INT_I0  is  new  TEXT_IO . INTEGER_IO ( integer ) ; 
package  BOOL_IO  is  new  TEXT_IO . ENUMERATION  10 (boolean) ; 
package  FLT_IO  is  new  TEXT_IO. FLOAT_IO(f loat) ; 
function  FINT  is  new  system. f etch_f rom_address ( integer) ; 
function  FCHAR  is  new  system. fetch_from_address (character) ; 
function  FBOOL  is  new  system. fetch_from_address (boolean) ; 
function  FFLT  is  new  system. fetch_from_address (float) ; 
procedure  AINT  is  new  system. assign_to_address( integer) ; 
procedure  ACHAR  is  new  system. ass ign_to_address (character) ; 
procedure  ABOOL  is  new  system. assign_to_address (boolean) ; 
procedure  AFLT  is  new  system. assign_to_address (float) ; 

— Shared  memory  system  call  interface 
function  SHMGET (KEY  : in  integer; 

SIZE  : in  integer; 

FLAG  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SHMGET); 
pragma  I NTERFAC E_N AME ( SHMGET , » shmget " ) ; 
function  SHMAT (SHMID  : in  integer; 

SHMADDR  : in  system. address; 

FLAG  : in  integer)  return  system. address; 
pragma  INTERFACE (C,  SHMAT); 
pragma  INTERFACE_NAME( SHMAT,  "shmat") ; 


constant 

constant 

constant 

constant 

constant 

constant 

constant 

constant 

constant 

constant 


integer 

integer 

integer 

integer 

integer 

integer 

integer 

integer 

integer 

integer 


10; 

10; 

10; 

10; 

99; 

100; 

INT_SIZE*4+CHAR_SIZE+BOOL  SIZE+4*FLT  SIZE 
INT_SIZE*4 ; 

CHAR_OFFSET  + CHAR_SIZE*1; 

BOOL_OFFSET  + BOOL  SIZE*1; 


function  SHMDT ( SHMADDR  : in  system. address)  return  integer; 

pragma  INTERFACE (C,  SHMDT); 

pragma  INTERFACE_NAME ( SHMDT , "shmdt") ; 

function  SHMCTL ( SHMID  : in  integer; 

CMD  : in  integer; 

BUFF  : in  system. address)  return  integer; 

pragma  INTERFACE (C,  SHMCTL); 
pragma  INTERFACE_NAME( SHMCTL,  "shmctl"); 

— Semaphore  system  call  and  C function  interface 
function  SEMGET (KEY  : in  integer; 

NSEMS  : in  integer; 

FLAG  : in  integer)  return  integer; 

pragma  INTERFACE (C,  SEMGET); 
pragma  INTERFACE_NAME( SEMGET,  "semget"); 
function  SEMSINIT(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE ( C , SEMSINIT) ; 
pragma  INTERFACE_NAME( SEMSINIT,  "semsinit"); 
function  SEMPRINT ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMPRINT); 
pragma  INTERFACE_NAME ( SEMPRINT,  "semprint") ; 
function  READBEG( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READBEG); 
pragma  INTERFACE_NAME (READBEG,  "readbeg") ; 
function  READ END ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE ( C , READEND ) ; 
pragma  INTERFACE_NAME( READEND,  "readend"); 
function  WRITEBEG( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEBEG) ; 
pragma  INTERFACE_NAME (WRITEBEG,  "writebeg"); 
function  WRITEEND( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEEND); 
pragma  INTERFACE_NAME (WRITEEND,  "writeend") ; 
function  SEMSRMV( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMSRMV) ; 
pragma  INTERFACE_NAME( SEMSRMV,  "semsrmv”) ; 

end  RODB_Component_Data_Types ; 
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J ob  s r odb_component_ . ada 
Date:  Sat  Apr  11  22:29:11  1992 


with  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types; 
use  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types; 
package  Rodb_Component  is 

— Package  renaming 

package  RCDT  renames  Rodb_Component_Data_Types ; 

— Exception  definition 
Shm_Exception  : exception; 

Shm_Outrange  : exception; 

Sem_Exception  : exception; 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs(Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  out  RCDT.Attr_List_Type) ; 

— Write  attributes  to  RODB  components 

procedure  Write_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  RCDT.Attr_List_Type) 

— Print  out  the  semaphore  values 

procedure  Print_Sems; 

— Load  RODB  components  from  a disk  file 

procedure  Load_Comps (Filename  : in  string); 

— Save  RODB  components  to  a disk  file 

procedure  Save_Comps (Filename  : in  string); 

— Shutdown  the  RODB  components 
procedure  Shutdown_Comps ; 


end  RODB  COMPONENT; 
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Job : rodb_component . ada 

Date:  Sat  Apr  11  22:29:31  1992 


with  TEXT_IO,  CALENDAR,  SYSTEM,  PREEMPT I ON_CONTROL,  Rodb_Component_DataJTypes ; 
use  TEXT_IO , CALENDAR,  SYSTEM,  PREEMPTION_CONTROL , Rodb_Component_Data_Types; 
package  body  Rodb_Component  is 

— Local  variables 
Shmid  : integer; 

Shmaddr  : system. address; 

Semid  : integer; 


— Local  subprograms 
procedure  Load_Ints (Inf ile  : in 
procedure  Load_Chars( Infile  : in 
procedure  Load_Bools( Infile  : in 
procedure  Load_Flts (Inf ile  : in 
procedure  Save_Ints (Outf ile  : in 
procedure  Save_Chars (Outf ile  : in 
procedure  Save_Bools (Outf ile  : in 
procedure  Save_Flts (Outf ile  : in 


FILEJTYPE) ; 
FILEJTYPE) ; 
FILE_TYPE) ; 
FILE_TYPE) ; 
FILEJTYPE)  ; 
FILE_TYPE) ; 
FILE_TYPE) ; 
FILE_TYPE)  ; 


— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  out  RCDT . Attr_List_Type ) is 
Temp  : system. address; 

Flag  : integer; 
begin 

— PREEMPTION_CONTROL . DISABLE_PREEMPTION; 

Flag  : = RCDT. READBEG (Semid) ; 

— PREEMPTION_CONTROL . ENABLE_PREEMPTION ; 
if  Flag  - -1  then 

raise  Sem_Exception; 
end  if ; 

for  I in  1 . . Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr_List (I)  > RCDT.SHM_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp  Shmaddr  + system. offset (Addr_List (I) ) ; 
if  (Addr  List (I)  < RCDT . CHAR_OFFSET)  then 

Attr_Llst(I)  (Type_ID  ->  0,  Int_Value  =>  RCDT. FINT (Temp) ) ; 
elsif  (Addr_List (I)  < RCDT . BOOL_OFFSET)  then 

Attr_List (I)  :*  (Type_ID  =>  1,  Char_Value  =>  RCDT. FCHAR( Temp) ) ; 
elsif  (Addr_List (I)  < RCDT. FLT_OFFSET)  then 

Attr_List(I)  :=>  (Type_ID  =>  2,  Bool_Value  =>  RCDT. FBOOL (Temp) ) ; 
else 

Attr_List (I)  (Type_ID  =>  3,  Flt_Value  =>  RCDT. FFLT( Temp) ) ; 
end  if; 
end  loop; 

— delay  10.0; 

— PREEMPTION_CONTROL . DISABLE_PREEMPTION ; 

Flag  RCDT. READ END ( Semid ) ; 

— PREEMPTION_CONTROL . ENABLE_PREEMPTION ; 
if  Flag  - -1  then 

raise  Sem_Exception; 
end  if; 

end  Read_Attrs; 

— Write  attributes  to  RODB  components 

procedure  Write_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  RCDT.Attr_List_Type)  is 


Temp  : system. address; 

Flag  : Integer; 
begin 

— PREEMPTION_CONTROL . DI SABLE_PREEMPTION ; 

Flag  :■  RCDT.WRITEBEG(Semid) ; 

— PREEMPTION_CONTROL . ENABLE_PREEMPTION ; 
if  Flag  * -1  then 

raise  Sem_Exception; 
end  if ; 

for  I in  1..  Length  loop 

if  (Addr_List(I)  < 0)  or  (Addr_List(I)  > RCDT.SHM  SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp  Shmaddr  + system. offset (Addr_List (I) ) ; 
if  (Addr_List (I)  < RCDT . CHAR_OFFSET)  then 
RCDT . AINT ( Temp , Attr_List(I) .Int_Value) ; 
elsif  (Addr_List (I)  < RCDT . BOOL_OFFSET)  then 
RCDT. ACHAR( Temp,  Attr_List(I) .Char_Value) ; 
elsif  (Addr_List(I)  < RCDT . FLT_OFFSET)  then 
RCDT. ABOOL( Temp,  Attr_List(I) .Bool_Value) ; 
else 

RCDT. AFLT( Temp,  Attr_List(I) .Flt_Value); 
end  if; 
end  loop; 

— delay  10.0; 

— PREEMPTION_CONTROL . DI SABLEJPREEMPTION ; 

Flag  RCDT.WRITEEND(Semid) ; 

— PREEMPTION_CONTROL. ENABLE  PREEMPTION; 
if  Flag  « -l  then 

raise  Sem_Exception; 
end  if; 

end  Write_Attrs; 

— Print  out  the  semaphore  values 
procedure  Print_Sems  is 
Flag  : integer; 
begin 

Flag  :*  RCDT.SEMPRINT(Semid) ; 
if  Flag  « -l  then 

raise  Sem_Exception; 
end  if ; 

end  Print_Sems; 

— Load  RODB  Components  from  a disk  file. 

— The  structure  of  disk  file  is  as  following: 

Number_Of_Integers 

— Positionl  Integerl 

Position2  Integer2 
♦ ♦ • 

— Number_Of_Characters 

— Positionl  Characterl 

— Position2  Character2 

• • • 

— Number_Of_Booleans 

— Positionl  Booleanl 
Position2  Boolean2 
• • • 

— Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 


procedure  Load_Comps (Filename  : in  string)  is 
Infile  : FILE_TYPE; 

Temp  : system. address; 

Flag  : integer; 
begin 

open(Infile,  in_file,  Filename) ; 

— Initialize  RODB  Integer  Component 
for  I in  l. .RCDT.INT_SIZE  loop 

Temp  :*  Shmaddr  + system. offset( (1-1) *4) ; 

RCDT . AINT ( Temp , 0 ) ; 
end  loop; 

Load_Ints( Infile) ; 

— Initialize  RODB  Character  Component 
for  I in  1. .RCDT.CHAR_SIZE  loop 

Temp  :=  Shmaddr  + system. offset (RCDT. CHAR_OFFSET  + 1-1) ; 
RCDT. ACHAR( Temp,  'X' ) ; 
end  loop; 

Load_Chars (Inf ile) ; 

— Initialize  RODB  Boolean  Component 
for  I in  1. .RCDT.BOOL_SIZE  loop 

Temp  :»  Shmaddr  + system. of f set (RCDT. BOOL_OFFSET  + 1-1) ; 
RCDT. ABOOL( Temp,  true) ; 
end  loop; 

Load_Bools (Infile) ; 

— Initialize  RODB  Float  Component 
for  I in  1 . . RCDT . FLT_SI ZE  loop 

Temp  :«  Shmaddr  + system. offset (RCDT. FLT_OFFSET  + (I-l)*4); 
RCDT . AFLT (Temp , 0.0); 
end  loop; 

Load_Flts (Infile) ; 
close (Inf ile) ; 

Flag  RCDT.SEMSINIT(Semid) ; 
if  Flag  * -1  then 
raise  Sem_Exception; 
end  if; 

exception 

when  name_error  -> 

put_line("File  cannot  be  opened."); 
put_line( "Loading  components  fails!"); 
when  data_error  | end_error  »> 

put_line("File  format  is  incompatible."); 
put_line( "Loading  components  fails!"); 
when  Sem_Exception  »> 

put_line(" Semaphore  cannot  be  initialized."); 
raise  Sem_Exception; 
when  others  -> 

put_line( "Unknown  exception."); 
put_line( "Loading  components  fails!"); 
end  Load_Comps; 

— Save  RODB  Components  to  a disk  file 


— The  structure  of  the  disk  file  is  as  following: 

Number_Of_lntegers 
Positionl  Integerl 
Position2  Integer2 

m m • 

Number_Of_Characters 
Positionl  Characterl 
Position2  Character2 
” ” • • * 

Number_Of_Booleans 
Positionl  Booleanl 

— Position2  Boolean2 


Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 


procedure  Save_Comps (Filename  : in  string) 
Outfile  : FILEJTYPE; 
begin 

if  Filename  /»  ""  then 

create (Outfile,  out_file.  Filename, 

f orm—>" world— >read 

Save_Ints (Outfile) ; 

Save_Chars (Outfile) ; 

Save_Bools (Outfile) ; 

Save_Flts (Outfile) ; 
close (Outfile) ; 
else 


is 


, owner=>read_write") 


/ 


Save_Ints (TEXT_IO . standard_output ) ; 
Save_Chars (TEXT_IO . standard  output) ; 
Save_Bools (TEXT_IO. standard“output) ; 
Save_Flts(TEXT_IO. standard  output) ; 
end  if; 
exception 

when  constraint_error  -> 

Put_line("RODB  Components  data  collapsed."); 
put_line(" Saving  components  failsl"); 
when  others  -> 

put_line( "Unknown  exception."); 
put_line(" Saving  components  fails!"); 
end  Save_Comps; 


— Shutdown  RODB  Components 
procedure  Shutdown_Comps  is 
Flag  : integer; 
begin 

Flag  RCDT . SHMDT ( Shmaddr ) ; 

if  Flag  - -l  then 
raise  Shm_Exception; 
end  if; 

• ” RCDT.SHMCTL(Shmid,  0,  system. null  address) ; 
if  Flag  - -1  then 
raise  Shm  Exception; 
end  if; 

Flag  RCDT. SEMSRMV ( Semid) ; 

if  Flag  - -l  then 
raise  Sem  Exception; 
end  if; 

end  Shutdown_Comps ; 


pragma  page; 


— Load  all  the  integers  from  a disk  file  to  RODB  Integer  Component 
procedure  Load  Ints( Infile  : in  FILE_TYPE)  is 

Length  : Integer; 

Temp_Pos  : integer ; 

Temp_Int  : integer; 

Temp_Addr  : system . address ; 
begin 

INT_IO. get (Infile,  Length); 

skip_line (Infile) ; 

for  I in  1 . . Length  loop 

INT_IO . get (Infile,  Temp_Pos ) ; 

INT_IO.get (Inf ile,  Temp_Int) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. INT_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if ; 

Temp_Addr  :=  Shmaddr  + system. offset (Temp_Pos*4 ) ; 

RCDT . AINT ( Temp_Addr , Temp_Int ) ; 
end  loop; 
end  Load_Ints; 

— Load  all  the  charaters  from  a disk  file  to  RODB  Character  Component 
procedure  Load  Chars (Infile  : in  FILE_TYPE)  is 

Length  : Integer ; 

Temp_Pos  : integer ; 

Temp_Char  : character ; 

Temp_Addr  : system. address; 
begin 

INT_IO . get ( Infile , Length) ; 

skip_line( Infile) ; 

for  I in  1.. Length  loop 

INT_I0. get (Infile,  Temp_Pos) ; 

get (Infile,  Temp_Char) ; — Skip  a space 

get (Infile,  Temp_Char) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.CHAR_SIZE-1)  then 
raise  Shm_Outrange; 
end  if; 

Temp_Addr  : - Shmaddr  + system,  offset  (RCDT..  CHAR_OFFSET+Temp_Pos)  ; 
RCDT . ACHAR ( Temp_Addr , Temp_Char) ; 
end  loop; 
end  Load_Chars; 

— Load  all  the  booleans  from  a disk  file  to  RODB  Boolean  Component 
procedure  Load  Bools (Infile  : in  FILE_TYPE)  is 

Length  : Integer ; 

Temp_Pos  : integer; 

Temp_Bool  : boolean; 

Temp_Addr  : system. address; 
begin 

INT_IO . get ( Infile , Length) ; 

skip_line( Infile) ; 

for  I in  1 . . Length  loop 

INT_IO . get ( Inf ile,  Temp_Pos ) ; 

BOOL_IO.get (Inf ile,  Temp_Bool) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.BOOL_SIZE-l)  then 


raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :«  Shmaddr  + system. offset (RCDT. BOOL  OFFSET+Temp  Pos) • 
RCDT . ABOOL ( Temp_Addr , Temp_Bool) ; ~ ~ 

end  loop; 
end  Load_Bools; 

— Load  all  the  floats  from  a disk  file  to  RODB  Float  Component 
procedure  Load  Fits (Infile  : in  FILEJTYPE)  is 
Length  : Tnteger ; 

Temp_Pos  : integer; 

Temp_Flt  : float; 

Temp_Addr  : system . address ; 

begin 

INT_IO. get (Infile,  Length) ; 

skip_line( Infile) ; 

for  I in  1 . . Length  loop 

INT_IO. get (Infile,  Temp_Pos) ; 

FLT_IO.get (Inf ile,  Temp  Fit) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.FLT_SIZE-1)  then 
raise  Shm_Outrange; 
end  if; 

Temp_Addr  Shmaddr  + system,  offset  (RCDT.  FLT  OFFSET+Temp  PosMl  • 
RCDT . AFLT ( Temp_Addr , Temp_Flt) ; ~ 

end  loop; 
end  Load_Flts; 

pragma  page; 


Sa\re  all  the  integers  from  RODB  Integer  Component  to  a disk  file 
procedure  Save_lnts( Out file  : in  FILE  TYPE)  is 
Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Integers  is:  ") ; 

I nt_IO . put ( Out f ile,  RCDT . I NT  SIZE) ; 
new_line (Outf ile) ; 
for  I in  1. .RCDT.INT_SIZE  loop 
put(Outfile,  "Integer  number  ") ; 

Int_IO.put(Outfile,  1-1,  width  =>  5) ; 
put (Out file,  ":"); 

Temp_Addr  :■  Shmaddr  + system. offset( (1-1) *4) ; 

Int_IO.put (Outf lie,  RCDT. FINT (Temp  Addr) ) ; 
new_line(Outfile) ; ” 

end  loop; 
end  Save_Ints; 

~ Save  all  the  characters  from  RODB  Character  Component  to  a disk  file 
procedure  Save_Chars( Out file  : in  FILE  TYPE)  is 
Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Characters  is:  ") ; 

Int_IO . put ( Outf ile,  RCDT. CHAR  SIZE); 
new_line (Outf ile) ; 
for  I in  1. .RCDT.CHAR_SIZE  loop 
put (Out file,  "Character  number  "); 
lnt_lO. put (Outf ile,  i-i,  width  =>  5) ; 
put (Outf ile,  ":"); 

Temp_Addr  :«  Shmaddr  + system. offset (RCDT. CHAR  OFFSET  + 1-1) ; 
put (Outf ile,  RCDT . FCHAR (Temp_Addr ) ) ; 


new_line ( Out file) ; 
end  loop; 
end  Save_Chars; 

— Save  all  the  booleans  from  RODB  Boolean  Component  to  a disk  file 

procedure  Save_Bools (Outf ile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Booleans  is:  ") ; 

Int_IO. put (Outf ile,  RCDT.BOOL_SIZE) ; 
new_line( Out file) ; 
for  I in  1. .RCDT.BOOL_SIZE  loop 
put(Outfile,  "Boolean  number  "); 

Int_IO. put (Out file,  1-1,  width  =>  5) ; 
put (Outf ile,  ":"); 

Temp_Addr  :=  Shmaddr  + system. offset (RCDT.BOOL_OFFSET  + I-l) ; 
Bool_IO. put (Outf ile,  RCDT . FBOOL (Temp_Addr) ) ; 
new_line (Outf ile) ; 
end  loop; 
end  Save_Bools; 

— Save  all  the  floats  from  RODB  Float  Component  to  a disk  file 

procedure  Save_Flts (Outf ile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Floats  is  "); 

Int_IO. put (Out file,  RCDT. FLT_SIZE) ; 
new_line (Outf ile) ; 
for  I in  1 . . RCDT . FLT_SI  ZE  loop 
put(Outfile,  "Float  number  ") ; 

Int_l0.put (Outf ile,  I-l) ; 
put (Out file,  ":"); 

Temp_Addr  :*  Shmaddr  + system. offset (RCDT. FLT_OFFSET  + (I-l) *4); 
Flt_IO. put (Outf ile,  RCDT . FFLT (Temp_Addr ) ) ; 
new_line( Out file) ; 
end  loop; 
end  Save_Flts; 

pragma  page; 

begin 

Shmid  :»  RCDT. SHMGET (RCDT. SHMKEY,  RCDT. SHM_SIZE,  1023); 
if  Shmid  ■ -1  then 
raise  Shm_Exception; 
end  if; 

Shmaddr  :=  RCDT. SHMAT( Shmid,  system. null_address,  0); 

— if  Shmaddr  » system. null_addr ess  then 

raise  Shm_Exception; 

— end  if ; 

semid  :»  RCDT. SEMGET( RCDT. SEMKEY,  3,  1023); 
if  Semid  = -1  then 
raise  Sem_Exception; 
end  if ; 

— Initialize  the  RODB  Components 
Load_Comps ( "rodbcomp . dat " ) ; 


end  Rodb_Component ; 
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Job:  readbeg.c 

Date:  Sat  Apr  11  23:40:14  1992 


/*  File:  readbeg.c  This  is  read  begin  subroutine  to  set  reading  protection  */ 
/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 

struct  sembuf  RREAD_START  = { 0 , 1,  0>; 

struct  sembuf  RWAIT_NO_WRITE_LOCK  ■ ( 1,  0,  Ob- 
struct sembuf  RWAIT_NO_WRITE_DESIRE  - { 2,  0,  0}; 

int  readbeg(semid) 
int  semid; 

struct  sembuf  one_of _n_readers [ 5 ] ; /*  Three  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid_t  my_tid; 

int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */  /*  Guarantee  atomic  ops  */ 
my_tid  ■ getstid(); 
my_prio  - getprio(getpid() ) ; 
fast_setprio(my_tid,  31); 

/*  Perform  three  semaphore  operations  *//*  Two  ops  are  repeated  */ 
one_of_n_readers(0]  - RWAIT_NO_WRITE_LOCK;  /*  Wait  for  no  more  writer  */ 

one_of _n_readers [ 1 ] « RWAIT_NO_WRITE_DESIRE;  /*  Wait  for  no  more  writer  */ 

one_of_n_readers [ 2 ] = RWAIT_NO_WRITE_LOCK;  /*  Wait  for  no  more  writer  */ 

one_of _n_readers [ 3 ] ■ RWAIT_NO_WRITE_DESIRE;  /*  Wait  for  no  more  writer  */ 

one_of_n_readers [ 4 ] =*  RREAD_START;  /*  Prevent  writer  in  */ 

flag  » semop (semid,  one_of_n_readers , 5) ; /*  Lock  the  critical  section  */ 

if  (flag  =-  -1)  { 

perror ("readbeg  fails:  ") ; 

> 

/*  Lower  the  priority  to  the  normal  */ 
fast_setprio(my_tid,  my_prio) ; 

return  flag; 


} 
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Job:  readend.c 

Date:  Sat  Apr  11  23:40:15  1992 


/*  File: 
/include 
/include 
/include 
/include 
/include 


readend.c  This  is  read  end  subroutine  to  reset  protection  */ 
<sys/ types. h> 

<sys/ipc.h> 

<sys/sem.h> 

<sys/sched.h> 

<st.h> 


/*  The  operations  on  the  semaphore  */ 
struct  sembuf  RREAD_END  = { 0,  -1,  0} ; 

int  readend(semid) 
int  semid; 

{ 

int  flag; 
void  perror ( ) ; 
tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  preemption  */ 
my_tid  = getstid(); 
my_prio  - getprio(getpid() ) ; 
fast_setprio(my_tid,  31) ; 

/*  Perform  the  semaphore  operation  */ 

flag  ■ semop(semid,  &RREAD_END , 1);  /*  Unlock  critical  section  */ 

if  (flag  ™ -1)  { 

perror ("readend  fails:  ") ; 

> 

/*  Lower  the  priority  to  the  normal  */ 
fast_setprio(my_tid,  my_prio) ; 

return  flag; 

} 
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/*  File:  writebeg.c  This  is  the  write  begin  subroutine  to  set  protection  */ 
/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/ inc lude  < sy s / sched . h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 

struct  sembuf  WWAIT_NO_READERS  = { 0,  0,  0}; 

struct  sembuf  WREAD_START  = { 0,  1,  0>;  /*lock  out  another  writer*/ 

struct  sembuf  WWRITE_LOCK  = { 1,  1,0}; 

struct  sembuf  WWRITE_DESIRE  = { 2,  1,  0>; 

struct  sembuf  WIN_PROGRESS_WRITE  - { 2,  -1,  0>;  /*  unlock  write  desire/  */ 

/*  /Guarantees  writer  progress  */ 

int  writebeg(semid) 
int  semid; 

{ 

struct  sembuf  sole_writer [4 ] ; /*  Four  semaphore  operations  */ 

int  flag; 

void  perror ( ) ; 

tid_t  my_tid; 

int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  = getstid(); 
my_prio  = getprio(getpid() ) ; 
fast_setprio(my_tid,  31) ; 

/*  Make  write  request  by  doing  a semaphore  operation  */ 
flag  - semop( semid,  &WWRITE_DESIRE,  1) ; 
if  (flag  ==  -1)  { 

perror ("Write-Request  in  writebeg  fails:  ") ; 
return  flag; 

> 

/-*  Perform  four  semaphore  operations  */ 

sole_writer[0]  - WWAIT_NO_READERS ; /*  Wait  for  no  more  readers  */ 

sole_writer[l]  - WWRITE_LOCK;  /*  preventing  succeeding  readers  */ 

sole_writer[2]  » WREAD_START ; /*  preventing  succeeding  writers  */ 

sole_writer[3]  » WIN_PROGRESS_WRITE;  /*  Cancel  the  write-request/  */ 

flag  * semop(semid,  sole_writer,  4) ; /*  Lock  the  critical  section  */ 

if  (flag  = -1)  { 

perror ("Write_Start  in  writebeg  fails:  ") ; 

> 

/*  /Note  cancelling  the  write-request  allows  another  writer  to  lock  it  */ 

/*  Lower  the  priority  to  the  normal  */ 
fast_setprio(my_tid,  my_prio) ; 

return  flag; 
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/*  File:  writeend.c  This  is  write  end  subroutine  to  reset  write  protection  */ 
/include  <sys/types.h> 

#include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 
struct  sembuf  WREAD_END  = { 0,  -1,  0>; 

struct  sembuf  WWRITE_UNLOCK  = { 1,  -1,  0}; 

int  writeend(semid) 
int  semid; 

* struct  sembuf  sole_writer[2] ; /*  Two  semaphore  operations  */ 

int  flag; 
void  perror(); 
tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  - getstid ( ) ; 
my_prio  * getprio(getpid() ) ; 
fast_setprio(my_tid,  31) ; 

/*  Perform  the  semaphore  operation  */ 

sole_wr iter [ 0 ] = WREAD_END ; /*  Allow  writer  in  */ 

sole_wr iter [ 1 ] = WWRITE_UNLOCK ; /*  Allow  reader  in  */ 

flag  - semop(semid,  sole_writer,  2);  /*  Unlock  critical  section  */ 

if  (flag  ==  -1)  { 

perror ("writeend  fails:  M) ; 

} 

/*  Lower  the  priority  to  the  normal  */ 
fast_setprio(my_tid,  myjprio) ; 

return  flag; 

> 
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Task 
Reader 1 
Reader 2 
Writer 


Number_Of_Iterations  Times 
2500  12.98090 

2500  12.98090 

5000  17.08582 
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Task  Number_Of_Iterations  Times 

Reader 1 5000  25.99048 

Reader 2 5000  25.98096 

Writer  5000  25.99048 


Appendix  D-2 


Concurrent  (Competing) 
Reader  and  Writer  Performance  Test 


No  Prevention  of  Preemption  but  with  Semaphore  Protection  of  RODB 
Component. 
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Job:  read. me 

Date:  Mon  Apr  20  17:47:34  1992 


THERE  ARE  THREE  TASKS  RUNNING  IN  THE  SYSTEM:  TWO  READERS  AND  ONE  WRITER 
THEY  ARE  ACCESSING  THE  RODB  COMPONENT  WHICH  IS  PROTECTED  BY  A MECHANISM 
IN  RODBTSTE1,  ALL  THE  TASKS  HAVE  THE  SAME  PRIORITIES.  THE  RESULTS  ARE  IN 
FILES  RODBCOMP1 . OUT  (RODBCOMP11 . OUT  AND  RODBCOMP12 . OUT)  for  5000  reads  and 
5000  writes  as  well  as  10000  reads  and  5000  writes  respectively.  THESE  FILE* 
CORRESPOND  to  INPUT  FILES  RODBCOMP1.IN  (RODBCOMP11 . IN  and  RODBCOMP12 . IN) . 

This  directory  stores  all  the  files  to  build  up  RODB  "attribute"  components 
The  protection  mechanism  is  that  locking  is  set  at  the  RODB  level.  During  the 
^here  N0  Prevention  of  preemption.  Inside  the  C functions 
the  fast_setprio  system  calls  are  commented  out.  There  is  only  one  set  of  thre 
DHIX  semaphores  in  the  whole  system.  Before  actual  r.mding°  m o?  fi?i 
semaphore  operations  are  imposed  on  the  semaphores.  After  a read,  one 
semaphore  operation  is  imposed  on  a semaphore  (decreasing  reader  count) . 

Before  writing  there  are  two  levels  of  semaphore  operations  which  are 
imposed;  namely,  write-desire  and  write-lock.  For  write-desire  only  one 

«?a!^r?K0P?ra510n  iS  i“POS!f  ?n  its  semaphore  (test&lock)  and  when  that  is 
set  and  the  last  reader  has  finished,  then,  write-lock  is  set  as  one  of  a set 
of  four  semaphore  operations  imposed  on  the  semaphores.  After  the  writer 
finishes  writing,  a set  of  two  semaphore  operations  are  imposed  on  the 
semaphores  (unlocking  the  RODB  to  allow  readers  or  other  writer  in) 

THE  INTENT  IS  TO  DETERMINE  THE  EFFECT  OF  NOT  USING  PRIORITY  RAISE/LOWER 
MANIPULATION  WHICH  FORMERLY  GUARANTEED  THE  ATOMIC  NATURE  OF  THESEMAPHORE 
OPERATIONS.  THIS  TEST  IS  WITHOUT  THAT  COST.  SEMAPHORE 
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— This  package  provides  the  constants,  instantiated  packages,  system  calls 

— and  C functions  interfaces  to  C language  for  RODB  COMPONENT  package, 
with  TEXT_IO,  SYSTEM; 

use  TEXT_IO,  SYSTEM; 

package  RODB_COMPONENT_DATA_TYPES  is 

— Constants 
INT_SIZE  : 

CHAR_SIZE  : 

BOOL_SIZE  : 

FLT_SIZE  : 

SHMKEY  : 

SEMKEY  : 

SHM_SIZE  : 

CHAR_OFFSET  : 

BOOL_OFFSET  : 

FLT_OFFSET  : 

— Data  types 

type  Attr_Type ( Type_ID  : integer  :=  0)  is  record 
case  Type_ID  is 
when  0 => 

Int_Value  : integer; 
when  1 => 

Char_Value  : character; 
when  2 •> 

Bool_Value  : boolean; 
when  3 -> 

Flt_Value  : float; 
when  others  ■> 
null; 
end  case; 
end  record; 

type  Attr_List_Type  is  array ( integer  range  <>)  of  Attr_Type; 
type  Pos_List_Type  is  array ( integer  range  <>)  of  integer; 

— Package  instantiation 

package  INT_IO  is  new  TEXT_I0. INTEGER_IO( integer ) ; 
package  BOOL_IO  is  new  TEXT_IO. ENUMERATION_IO (boolean) ; 
package  FLT_I0  is  new  TEXT_IO.FLOAT_IO( float) ; 
function  FINT  is  new  system. fetch_from_address( integer) ; 
function  FCHAR  is  new  system. fetch_from_address (character) ; 
function  FBOOL  is  new  system. fetch_from_address (boolean) ; 
function  FFLT  is  new  system. fetch_from_address( float) ; 
procedure  AINT  is  new  system. assign_to_address( integer) ; 
procedure  ACHAR  is  new  system. assign_to_address (character) ; 
procedure  ABOOL  is  new  system. assign_to_address (boolean) ; 
procedure  AFLT  is  new  system. assigntoaddress (float) ; 

— Shared  memory  system  call  interface 

function  SHMGET (KEY  : in  integer; 

SIZE  : in  integer; 

FLAG  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SHMGET); 
pragma  INTERFACE_NAME( SHMGET,  "shmget"); 
function  SHMAT (SHMID  : in  integer; 

SHMADDR  : in  system. address; 

FLAG  : in  integer)  return  system. address; 

pragma  INTERFACE (C,  SHMAT); 
pragma  INTERFACE_NAME ( SHMAT,  "shmat") ; 


constant 

constant 

constant 

constant 

constant 

constant 

constant 

constant 

constant 

constant 


integer 

integer 

integer 

integer 

integer 

integer 

integer 

integer 

integer 

integer 


10; 

10; 

10; 

10; 

99; 

100; 

INT_SIZE*4+CHAR_SIZE+BOOL_SIZE+4*FLT  SIZE 
INT_SIZE*4 ; 

CHAR_OFFSET  + CHAR_SIZE*1; 

BOOLOFFSET  + BOOL_SIZE*l; 


function  SHMDT ( SHMADDR  : in  system. address)  return  integer 

pragma  INTERFACE (C,  SHMDT) ; 

pragma  INTERFACE_NAME ( SHMDT , "shmdt") ; 

function  SHMCTL ( SHMID  : in  integer; 

CMD  : in  integer; 

BUFF  : in  system. address)  return  integer 

pragma  INTERFACED,  SHMCTL)  ; 
pragma  INTERFACE_NAME( SHMCTL,  "shmctl") ; 

— Semaphore  system  call  and  C function  interface 
function  SEMGET (KEY  : in  integer; 

NSEMS  : in  integer; 

FLAG  : in  integer)  return  integer; 

pragma  INTERFACE (C,  SEMGET); 
pragma  INTERFACE_NAME ( SEMGET , "semget"); 
function  SEMSINIT(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE ( C , SEMSINIT) ; 
pragma  INTERFACE_NAME (SEMSINIT,  "semsinit")  ; 
function  SEMPRINT ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMPRINT); 
pragma  INTERFACE_NAME( SEMPRINT,  "semprint") ; 
function  READBEG (SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READBEG); 
pragma  INTERFACE_NAME ( READBEG , " readbeg" ) ; 
function  READEND (SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  READEND); 
pragma  INTERFACE_NAME ( READEND , " readend" ) ; 
function  WRITEBEG (SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEBEG); 
pragma  INTERFACE_NAME (WRITEBEG,  "writebeg") ; 
function  WRITEEND ( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  WRITEEND); 
pragma  INTERFACE_NAME (WRITEEND,  "writeend") ; 
function  SEMSRMV( SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMSRMV) ; 
pragma  INTERFACE_NAME ( SEMSRMV , " semsrmv" ) ; 

end  RODB_Component_Data_Types ; 
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with  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
use  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
package  Rodb_Component  is 

— Package  renaming 

package  RCDT  renames  Rodb_Component_Data_Types; 

— Exception  definition 
Shm_Exception  : exception; 

Shm_Outrange  : exception; 

Sem_Exception  : exception; 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs(Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  out  RCDT.Attr_List_Type) ; 

— Write  attributes  to  RODB  components 

procedure  Write_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  RCDT. Attr_List_Type) ; 

— Print  out  the  semaphore  values 
procedure  Print_Sems; 

— Load  RODB  components  from  a disk  file 

procedure  Load_Comps (Filename  : in  string); 

— Save  RODB  components  to  a disk  file 

procedure  Save_Comps (Filename  : in  string); 

— Shutdown  the  RODB  components 
procedure  Shutdown_Comps ; 


end  RODB  COMPONENT; 
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J ob : r odb_component . ada 

Date:  Mon  Apr  13  20:37:53  1992 


with  TEXT  10,  CALENDAR,  SYSTEM,  PREEMPT I ON_CONTROL,  Rodb_Component_Data_Types 
use  TEXT~ 10 , CALENDAR,  SYSTEM,  PREEMPT I 0N_C0NTR0L,  Rodb_Component_Data_Types 
package  body  Rodb_Component  is 

— Local  variables 
Shmid  : integer; 

Shmaddr  : system. address; 

Semid  : integer ; 


— Local  subprograms 
procedure  Load_Ints (Infile 
procedure  Load_Chars ( Infile 
procedure  Load_Bools( Infile 
procedure  Load_Flts (Infile 
procedure  Save_Ints (Outf ile 
procedure  Save_Chars( Outf ile 
procedure  Save_Bools (Outf ile 
procedure  Save_Flts (Outf ile 


in 

FILE  TYPE) 

in 

FILE  TYPE) 

in 

FILE  TYPE) 

in 

FILE  TYPE) 

in 

FILE  TYPE) 

in 

FILE  TYPE) 

in 

FILE  TYPE) 

in 

FILE  TYPE) 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  out  RCDT.Attr_List_Type)  is 
Temp  : system. address; 

Flag  : integer; 
begin 

— PREEMPTI0N_C0NTR0L . DISABLE_PREEMPTION ; 

Flag  RCDT. READBEG (Semid) ; 

— PREEMPTI0N_C0NTR0L . ENABLE_PREEMPT I ON ; 
if  Flag  * -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1 . . Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr_List (I)  > RCDT.SHM_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if ; 

Temp  :=  Shmaddr  + system. offset (Addr_List( I) ) ; 
if  (Addr  List (I)  < RCDT. CHAR_OFFSET)  then 

Attr_Llst(I)  :=  (Type_ID  =>  0,  Int_Value  *>  RCDT. FINT (Temp) ) ; 
elsif  (Addr_List (I)  < RCDT . BOOL_OFFSET)  then 

Attr_List(I)  (Type_ID  =»  1,  Char_Value  =>  RCDT. FCHAR (Temp) ) ; 
elsif  (Addr_List(I)  < RCDT. FLT_OFFSET)  then 

Attr_List (I)  :«  (Type_ID  =>  2,  Bool_Value  ->  RCDT. FBOOL (Temp) ) ; 
oX  S8 

Attr_List (I)  :»  (Type_ID  ->  3,  Flt_Value  ->  RCDT. FFLT (Temp) ) ; 
end  if ; 
end  loop; 

— delay  10.0; 

— PREEMPTI0N_C0NTR0L . DISABLE_PREEMPTION ; 

Flag  :=  RCDT. READEND( Semid ) ; 

— PREEMPTION_CONTROL . ENABLE_PREEMPTI0N ; 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

end  Read  Attrs; 


— Write  attributes  to  RODB  components 
procedure  Write_Attrs(Addr_List  : in 

Length  : in 
Attr  List  : in 


RCDT . Pos_List_Type ; 
integer; 

RCDT. Attr  List_Type)  is 


Temp  : system. address; 

Flag  : integer; 
begin 

— PREEMPTI ON_CONTROL . DISABLE_PREEMPTION ; 

Flag  RCDT. WRITEBEG(Semid) ; 

— PREEMPTIOH_CONTROL. ENABLE_PREEMPTION; 
if  Flag  * -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1..  Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr_List (I)  > RCDT.SHM_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp  Shmaddr  + system. offset (Addr_List (I) ) ; 
if  (Addr_List (I)  < RCDT . CHAR_OFFSET)  then 
RCDT. AINT( Temp,  Attr_List(I) .Int_Value) ; 
elsif  (Addr_List (I)  < RCDT . BOOL_OFFSET)  then 
RCDT . ACHAR (Temp , Attr_List (I) . Char_Value) ; 
elsif  (Addr_List(I)  < RCDT. FLT_OFFSET)  then 
RCDT. ABOOL (Temp,  Attr_List(I) .Bool_Value) ; 
else 

RCDT . AFLT (Temp , Attr_List (I) . Flt_Value) ; 
end  if;  “ 

end  loop; 

— delay  10.0; 

— PREEMPTION_CONTROL. DISABLE_PREEMPTION; 

Flag  RCDT.WRITEEND(Semid) ; 

— PREEMPTION_CONTROL.ENABLE_PREEMPTION; 
if  Flag  - -1  then 

raise  Sem_Exception; 
end  if; 

end  Write_Attrs; 

— Print  out  the  semaphore  values 
procedure  Print_Sems  is 
Flag  : integer; 
begin 

Flag  :=■  RCDT. SEMPRIHT(Semid)  ; 
if  Flag  ■ -l  then 

raise  Sem_Exception; 
end  if; 

end  Print_Sems; 

— Load  RODB  Components  from  a disk  file. 

— The  structure  of  disk  file  is  as  following: 

Number_Of_Integers 
Positionl  Integerl 
Position2  Integer2 
• • • 

Number_Of_Characters 
Positionl  Characterl 
Position2  Character 2 

• • m 

Number_Of_Boo leans 
Positionl  Booleanl 

— Position2  Boolean2 

*****  • • • 

Number_Of  _F  loa  t s 
Positionl  Floatl 
Position2  Float2 


string)  is 


procedure  Load_Comps (Filename  : in 
Infile  : FILE_TYPE; 

Temp  : system. address; 

Flag  : integer  ? 
begin 

open(Infile,  in_file.  Filename) ; 

— Initialize  RODB  Integer  Component 
for  I in  1. .RCDT.INT_SIZE  loop 

Temp  :=  Shmaddr  + system. of fset ( (1-1) *4) ; 

RCDT . AINT ( Temp , 0 ) ; 
end  loop; 

Load_Ints (Inf ile) ; 

— Initialize  RODB  Character  Component 
for  I in  1. .RCDT.CHAR_SIZE  loop 

Temp  Shmaddr  + system. offset (RCDT. CHAR_OFFSET  + 1-1) ; 
RCDT.  ACHAR(  Temp,  'X')/* 
end  loop; 

Load_Chars (Inf ile) ; 

— Initialize  RODB  Boolean  Component 
for  I in  1. .RCDT.BOOL_SIZE  loop 

Temp  :*  Shmaddr  + system. offset (RCDT. BOOL_OFFSET  + 1-1) ; 
RCDT. ABOOL( Temp,  true) ; 
end  loop; 

Load_Bools (Infile) ; 

— Initialize  RODB  Float  Component 
for  I in  1 . . RCDT . FLT_SI  ZE  loop 

Temp  Shmaddr  + system. offset (RCDT. FLT_OFFSET  + (I-l)*4) 
RCDT . AFLT ( Temp , 0.0); 
end  loop; 

Load_Flts (Infile) ; 
close (Inf ile) ; 

Flag  :=*  RCDT.SEMSINIT(Semid)  ; 
if  Flag  - -1  then 

raise  Sem_Exception; 
end  if; 

exception 

when  name_error  -> 

put_line("File  cannot  be  opened."); 
put_line( "Loading  components  fails!"); 
when  data_error  | end_error  => 

put_line("File  format  is  incompatible."); 
put_line( "Loading  components  fails!"); 
when  Sem_Exception  => 

put_line(" Semaphore  cannot  be  initialized."); 
raise  Sem_Exception; 
when  others  »> 

put_l ine ( "Unknown  exception . " ) ; 
put_line( "Loading  components  fails!"); 
end  Load_Comps; 

— Save  RODB  Components  to  a disk  file 


— The  structure  of  the  disk  file  is  as  following: 

Number_Of_Integers 
Position!.  Integerl 
Position2  Integer2 

Number_Of_Characters 

— Positionl  Characterl 

Position2  Character2 

” “ • • • 

Number_Of_Booleans 
Positionl  Booleanl 

— Position2  Boolean2 

™ ” • • « 

Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 
” ” • # • 

procedure  Save_Comps (Filename  : in  string)  is 
Outfile  : FILEJTYPE; 
begin 

if  Filename  /-  ""  then 

create (Outfile,  out_file,  Filename, 

form->"world*>read,  owner=>read  write"); 

Save_Ints (Outfile) ; 

Save_Chars (Outfile) ; 

Save_Bools (Outfile) ; 

Save_Flts (Outfile) ; 
close (Outfile) ; 
else 

Save_Ints (TEXT_IO. standard_output) ; 

Save_Chars (TEXT_IO. standard_output) ; 

Save_Bools (TEXT_IO. standard_output) ; 

Save_Flts (TEXT_IO. standard_output) ; 
end  if; 
exception 

when  constraint_error  »> 

put_line("RODB  Components  data  collapsed."); 
put_line(" Saving  components  fails! H) ; 
when  others  »> 

put_l ine ( "Unknown  exception . " ) ; 
put_line(" Saving  components  fails!"); 
end  Save_Comps; 

— Shutdown  RODB  Components 
procedure  Shutdown_Comps  is 

Flag  : integer; 
begin 

Flag  RCDT.SHMDT(Shmaddr) ; 
if  Flag  - -l  then 
raise  Shm_Exception; 
end  if; 

Flag  RCDT . SHMCTL ( Shmid , 0,  system. null  address); 

if  Flag  - -1  then 
raise  Shm_Exception; 
end  if; 

Flag  :»  RCDT.SEMSRMV(Semid) ; 
if  Flag  - -l  then 
raise  Sem_Exception; 
end  if; 

end  Shutdown_Comps ; 


pragma  page; 


--  Load  all  the  Integers  from  a disk  file  to  RODB  Integer  Component 
procedure  Load  Ints (Infile  : in  FILE_TYPE)  is 
Length  : Integer; 

Temp_Pos  : integer; 

Temp_Int  : integer; 

Temp_Addr  : system. address; 
begin 

INT_IO. get (Infile,  Length); 

skip_line (Infile) ; 

for  I in  1 . . Length  loop 

INT_IO. get (Infile,  Temp_Pos) ; 

INT_IO. get (Infile,  Temp_Int) ; 
skip  line(Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT. INT_SIZE-1)  then 
raise  Shm_Outr ange ; 
end  if; 

Temp_Addr  :=  Shmaddr  + system. offset (Temp_Pos*4) ; 

RCDT . AIHT ( Temp_Addr , Temp_Int) ; 
end  loop; 
end  Load_Ints; 

— Load  all  the  charaters  from  a disk  file  to  RODB  Character  Component 
procedure  Load  Chars (Infile  : in  FILE_TYPE)  is 

Length  : Integer; 

Temp_Pos  : integer ; 

Temp_Char  : character ; 

Temp_Addr  : system. address; 
begin 

INT_IO. get (Infile,  Length); 

skip_line (Infile) ; 

for  I in  1 . . Length  loop 

INT_IO.get(Infile,  Temp_Pos) ; 

get (Inf ile,  Temp_Char) ; — Skip  a space 

get (Infile,  Temp_Char) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.CHAR_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :=*  Shmaddr  + system. offset (RCDT. CHAR_OFFSET+Temp_Pos) ; 
RCDT . ACHAR ( Temp_Addr , Temp_Char ) ; 
end  loop; 
end  Load_Chars; 

— Load  all  the  booleans  from  a disk  file  to  RODB  Boolean  Component 
procedure  Load  Bools (Infile  : in  FILE_TYPE)  is 

Length  : Integer; 

Temp_Pos  : integer; 

Temp_Bool  : boolean; 

Temp_Addr  : system. address; 
begin 

INT_IO . get (Infile,  Length); 

skip_line( Infile) ; 

for  I in  1 . . Length  loop 

INT_I0 . get (Infile,  Temp_Pos ) ; 

BOOL_IO.get(Infile,  Temp_Bool) ; 
skip_line(Inf ile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.BOOL_SIZE-l)  then 


raise  Shm_Outrange; 
end  if; 

Temp_Addr  Shmaddr  + system. offset (RCDT. BOOL  OFFSET+Temp  Pos) • 
RCDT.ABOOL(Temp_Addr,  Temp_Bool) ; “ 

end  loop; 
end  Load_Bools; 

— Load  all  the  floats  from  a disk  file  to  RODB  Float  Component 
procedure  Load  Fits (Infile  : in  FILEJTYPE)  is 

Length  ; Integer; 

Temp_Pos  : integer; 

TempJFlt  : float; 

Temp_Addr  : system. address; 
begin 

INT_IO.get (Inf ile,  Length) ; 

skip_line( Infile) ; 

for  I in  1.. Length  loop 

INT_IO. get (Infile,  Temp_Pos) ; 

FLT_IO.get(Infile,  Temp  Fit) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.FLT_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  Shmaddr  + system. offset (RCDT. FLT  OFFSET+Temp  Pos*4) • 
RCDT.AFLT(Temp_Addr,  Temp_Flt) ; ~ ~ 

end  loop; 
end  Load_Flts; 

pragma  page; 

— Save  all  the  integers  from  RODB  Integer  Component  to  a disk  file 
procedure  Save_Ints(Outfile  : in  FILE  TYPE)  is 

Temp_Addr  : system. address;  ~ 

begin 

put(Outfile,  "Number  Of  Integers  is:  ") ; 

Int_IO. put (Out file,  RCDT. INT_SIZE) ; 
new_line(Outfile) ; 
for  I in  1. .RCDT.INT_SIZE  loop 
put (Out file,  "Integer  number  "); 

Int_IO . put (Outf ile,  1-1,  width  =>  5) ; 
put(Outfile,  ":"); 

Temp_Addr  Shmaddr  + system. offset ( (1-1) *4) ; 

Int_IO . put ( Outf ile,  RCDT. PINT (Temp  Addr) ) ; 
new_line (Outf ile) ; 
end  loop; 
end  Save_Ints; 

Save  all  the  characters  from  RODB  Character  Component  to  a disk  file 
procedure  Save_Chars (Outf ile  : in  FILE_TYPE)  is 
Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Characters  is:  ") ; 

Int_IO. put (Outf ile,  RCDT.CHAR_SIZE) ; 
new_line (Outf ile) ; 
for  I in  1. .RCDT.CHAR_SIZE  loop 
put (Outf ile,  "Character  number  ") ; 

Int_IO.put (Outf ile,  I-l,  width  ->  5); 
put (Outf ile,  ":"); 

Temp_Addr  Shmaddr  + system. offset (RCDT. CHAR  OFFSET  + I-l); 
put (Outf ile,  RCDT. FCHAR(Temp_Addr) ) ; 


new_line(Outf ile) ; 
end  loop; 
end  Save_Chars; 

— Save  all  the  booleans  from  RODB  Boolean  Component  to  a disk  file 

procedure  Save_Bools (Outf ile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Booleans  is:  ") ; 

Int_IO.put (Outf ile,  RCDT.BOOL_SIZE) ; 
new_line (Out file) ; 
for  I in  1. .RCDT.BOOL_SIZE  loop 
put (Outf ile,  "Boolean  number  ") ; 

Int_IO. put (Out file,  1-1,  width  =>  5) ; 
put ( Outf ile,  " : " ) ; 

Temp_Addr  Shmaddr  + system. offset (RCDT.BOOL_OFFSET  + 1-1) ; 
Bool_IO . put ( Outf ile,  RCDT . FBOOL (Temp_Addr ) ) ; 
new_line( Out file) ; 
end  loop; 
end  Save_Bools; 

— Save  all  the  floats  from  RODB  Float  Component  to  a disk  file 

procedure  Save_Flts (Outf ile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put(Outfile,  "Number  Of  Floats  is  ") ; 

Int_IO . put ( Out f i le , RCDT . FLT_SI ZE ) ; 
new_line (Outf ile) ; 
for  I in  1 . . RCDT . FLT_SIZE  loop 
put(Outfile,  "Float  number  ") ; 

Int_IO.put (Outf ile,  1-1) ; 
put(Outfile,  ":"); 

Temp_Addr  : = Shmaddr  + system . o f f set ( RCDT . FLT_OFFSET  + ( I - 1 ) * 4 ) ; 
Flt_IO.put (Outf ile,  RCDT.FFLT(Temp_Addr) ) ; 
new_line (Out file) ; 
end  loop; 
end  Save_Flts; 

pragma  page ; 

begin 

shmid  RCDT. SHMGET (RCDT. SHMKEY,  RCDT. SHM_SIZE,  1023); 
if  Shmid  - -1  then 
raise  Shm_Exception; 
end  if; 

Shmaddr  RCDT. SHMAT( Shmid,  system. null_addr ess,  0); 

— if  Shmaddr  ■ system. null_address  then 

raise  Shm_Exception; 

— end  if; 

semid  :=  RCDT. SEMGET( RCDT. SEMKEY,  3,  1023); 
if  Semid  * -1  then 
raise  Sem_Exception; 
end  if; 

— Initialize  the  RODB  Components 
Load_Comps ( "rodbcomp . dat " ) ; 


end  Rodb_Component ; 
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J ob : rodb_test_data 1 . ada 

Date:  Mon  Apr  13  20:38:44  1992 


with  TEXT_IO ; 
use  TEXT_IO; 

package  RODB_Test_Datal  is 

Number_Of_Timesl  : integer; 

Number_0f_Times2  : integer; 

Number_0f_Times3  : integer; 

package  INT_IO  is  new  TEXT_IO.INTEGER_IO( integer) 

end  RODB_Test_Datal; 

with  TEXT_IO ; 
use  TEXT_IO; 

package  body  RODB_Test_Datal  is 
Infile  : file_type; 
begin 

open (Infile,  in_file,  "rodbcompl. in") ; 

INT_IO. get (Infile,  Number_Of_Timesl) ; 

INT_IO. get (Infile,  Number_0f_Times2) ; 

INT_IO . get ( Infile , Number_Of _Times3 ) ; 
close(Inf ile) ; 
end  RODB  Test  Datal; 
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Job : rodbtstEl . ada 

Date:  Mon  Apr  13  20:49:27  1992 


— This  is  the  concurrent  reading  and  writing  test  program 

with  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
use  TEXT  10,  CALENDAR,  SYSTEM,  RODB  Component  Data  Types,  RODB  Component; 


with  RODB_Test_Datal ; 
procedure  RodbtstEl  is 

— Constant  definitions 
ATTR_SIZE  : constant  integer 

NUMBER_0F_TIMES1  : constant  integer 
NUMBER_0F_TIMES2  : constant  integer 
NUMBER  OF  TIMES3  : constant  integer 


:=  200; 

: = RODB_Test_Datal . Number_Of_Timesl ; 
: = RODB_Test_Datal . Number_Of_Times2 ; 
: = RODB_Test_Datal . Number_0f_Times3 ; 


— Package  instantiation 

package  INT_I0  is  new  TEXT_I0. INTEGER_IO( integer ) ; 
package  FIX_I0  is  new  TEXT_I0. FIXED_I0 (duration) ; 
package  RCDT  renames  RODB_Component_Data_Types; 
package  RODBCP  renames  RODB_Component ; 

— task  declaration 
task  Readerl  is 

entry  Finish; 
end  Readerl; 
task  Reader2  is 
entry  Finish; 
end  Reader2; 
task  Writer  is 

entry  Finish; 
end  Writer; 


— Variable  definition 


Start_Timel 

Start_Time2 

Start_Time3 

Finish_Timel 

Finish_Time2 

Finish_Time3 

Resultl 

Result 2 


CALENDAR. 

CALENDAR. 

CALENDAR. 

CALENDAR. 

CALENDAR. 

CALENDAR. 

duration; 

duration; 


time; 

time; 

time; 

time; 

time; 

time; 


Result3 

Addr_Listl 

Addr_List2 

Addr_List3 

Attr_Listl 

Attr_List2 

Attr_List3 

Lengthl 

Length2 

Length3 

Outfile 


duration; 

RCDT . Pos_List_Type ( 1 . . ATTR_SIZE) 
RCDT . Pos_List_Type ( 1 . . ATTR_SIZE)- 
RCDT . Pos_List_Type ( 1 . . ATTR_SIZE) 
RCDT . Attr_List_Type ( 1 . . ATTR_SI ZE) 
RCDT . Attr_List_Type ( 1 . . ATTR_SIZE) 
RCDT . Attr_List_Type ( 1 . . ATTR_SI ZE) 
integer  :■  1; 
integer  :»  1; 
integer  : - 1; 
file_type; 


(0,  others=>0) ; 

(0,  other s*>0) ; 

(0,  other s~>0) ; 

( (0,200) ,others«> (0,200)  ) ; 
( (0,200) ,others=>(0,200) ) ; 
( (0,200) ,others*> (0,200) ) ; 


— The  body  of  task  readerl 
task  body  Readerl  is 
begin 

Start_Timel  : » CALENDAR . clock ; 

for  I in  1 . . NUMBER_0F_TIMES1  loop  — Read  is  without  preemption  protection 
RODBCP . Read_Attrs ( Addr_List 1 , Lengthl , Attr_List 1) ; 
end  loop ; 

Finish_Timel  :=  CALENDAR. clock; 

Resultl  :»  Finish  Timel  - Start  Timel; 


accept  Finish; 
exception 

when  others  => 

put_line("Task  Readerl  has  an  exception."); 
end  Readerl; 

— The  body  of  task  reader2 
task  body  Reader2  is 
begin 

Start_Time2  CALENDAR. clock; 
for  I in  1. .NUMBER_0F_TIMES2  loop 

R0DBCP.Read_Attrs(Addr_List2,  Length2,  Attr_List2) ; 
end  loop; 

Finish_Time2  CALENDAR. clock; 

Result2  :*  Finish_Time2  - Start_Time2 ; 

accept  Finish; 
exception 

when  others  =■> 

put_line("Task  Reader2  has  an  exception."); 
end  Reader2 ; 

— The  body  of  task  writer 
task  body  Writer  is 
begin 

Start_Time3  :«  CALENDAR. clock; 

for  I in  1 . . NUMBER_0F_TIMES3  loop  — Similarly  no  preemption  protection 
RODBCP. Write_Attrs (Addr_List3 , Length3,  Attr_List3) ; 
end  loop; 

Finish_Time3  CALENDAR. clock; 

Result3  Finish_Time3  - Start_Time3; 

accept  Finish; 
exception 

when  others  ~> 

put_line("Task  Writer  has  an  exception."); 
end  Writer; 

begin 

— Terminate  gracefully 
Readerl . Finish ; 

Reader 2 . Finish; 

Writer . Finish ; 

— Write  out  the  results 

create (Outfile,  out_file,  "rodbcompl.out", 

form*>"world«>read,  owner*>read_write") ; 
put_line (Outfile,  "Task  Number_Of  Iterations  Times"); 

put(Outfile,  "Readerl  ") ; 

INT_IO .put (Outfile,  NUMBER_OF_TIMES 1 ) ; 

FIX_IO.put (Outfile,  Resultl) ; 

new_line (Outfile) ; 

put (Outfile,  "Reader 2 ") ; 

INT_IO.put (Outfile,  NUMBER_0F_TIMES2) ; 

FIX_IO. put (Outfile,  Result2); 

new_line (Outfile) ; 

put (Outfile,  "Writer  ") ; 

INT_IO. put (Out file,  NUMBER_OF_TIMES3 ) ; 

FIX_IO. put (Out file,  Result3); 


new_l ine ( Out f i le ) 
close (Outfile) ; 


end  RodbtstEl; 


t 

t 


r rrr 

oooo 

oooo 

ttttt 

rr  r 

o 

o 

o 

o 

t 

r 

o 

o 

o 

o 

t 

r 

o 

o 

o 

o 

t 

r 

o 

o 

o 

o 

t t 

r 

oooo 

oooo 

tt 

r rrr 

oooo 

rr  r 

o o 

r 

o o 

r 

o o 

r 

o o 

r 

oooo 

d 

d 

d 

ddd  d 
d dd 
d d 
d d 
d dd 
ddd  d 


b 

b 

b 

b bbb 
bb  b 
b b 

b b 

bb  b 
b bbb 


cccc 
c c 

c 
c 

c c 

cccc 


oooo 
o o 

o o 

o o 

o o 

oooo 


m 

in  mm 

nun 

m 

m 

m 

m 

m 

m 

m 

m 

m 

m 

m 

m 

m 

m 

p ppp 
pp  p 
p p 

p p 

pp  p 
p ppp 
p 
p 
p 
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Date:  Mon  Apr  13  20:49:49  1992 
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Job:  readbeg . c 

Date:  Mon  Apr  13  20:49:59  1992 


/*  File:  readbeg.c  This  is  read  begin  subroutine  to  set  reading  protection  */ 
/include  <sys/types ,h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 

I*  The  operations  on  semaphores  */ 
struct  sembuf  RREAD_START  = { 0,  1,  0}; 

struct  sembuf  RWAIT_NO_WRITE_LOCK  = { 1,  0,  Ob- 
struct sembuf  RWAIT_NO_WRITE_DESIRE  = { 2,  0,  0>; 

int  readbeg(semid) 
int  semid; 

* struct  sembuf  one_of _n_readers [ 5 ] ; /*  Three  semaphore  operations  */ 

int  flag; 
void  perror ( ) ; 
tid_t  my_tid; 
int  myjprio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  * getstid(); 
my_prio  - getprio(getpid() ) ; 

/*  fast_setprio(my_tid,  31) ; */  /*  Not  this  time!  */ 

/*  the  fast  setting  of  the  priority  is  commented  out  */ 

/*  Perform  three  semaphore  operations  */ 

one  of  n_readers ( 0 ] = RWAIT_NO_WRITE_LOCK;  /*  Wait  for  no  more  writer  */ 

one- of  n readersfl]  = RWAIT_NO_WRITE_DESIRE ; /*  Wait  for  no  more  writer  */ 

one- of- n_readers [ 2 ] - RWAIT_NO_WRITE_LOCK;  /*  Wait  for  no  more  writer  */ 

one_of_n_readers [ 3 ] - RWAIT_NO_WRITE_DESIRE ; /*  Wait  for  no  more  writer  */ 

one_of_n_readers [ 4 ] - RREAD_START;  /*  Prevent  writer  in  */ 

flag  - semop(semid,  one_of _n_readers , 5);  /*  Lock  the  critical  section  */ 

if  (flag  — -1)  { 

perror ( " r eadbeg  fails:  " ) ; 

} 

/*  Lower  the  priority  to  the  normal  */ 

/*  fast_setprio(my_tid,  myjprio);  */ 

/*  the  lowering  of  the  priority  is  also  commented  out  */ 
return  flag; 


} 
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Job:  readend.c 

Date:  Mon  Apr  13  20:50:16  1992 


/*  File: 
/include 
/ include 
/include 
/include 
/include 


readend.c  This  is  read  end  subroutine  to  release  protection  */ 
< sys/ types. h> 

<sys/ipc.h> 

<sys/sen.h> 

<sys/sched.h> 

<st.h> 


/*  The  operations  on  the  semaphore  */ 
struct  sembuf  RREAD_END  = { 0,  -1,  0}; 

int  readend(semid) 
int  semid; 

{ 

int  flag; 
void  perror ( ) ; 
tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */  /*  Not  here  ! ! */ 
my_tid  - getstid() ; 
my_prio  * getprio(getpid() ) ; 

/*  fast_setprio(my_tid,  31);  */ 

/*  The  fast  setting  of  the  priority  is  commented  out  */ 

/*  Perform  the  semaphore  operation  */ 

flag  « semop(semid,  &RREAD_END,  1);  /*  Unlock  critical  section  */ 

if  (flag  — -1)  { 

perror ("readend  fails:  n) ; 

} 

/*  Lower  the  priority  to  the  normal  */  /*  Also  not  here  either  ! ! */ 

/*  fast_setprio(my_tid,  my_prio) ; */ 

/*  The  lowering  of  the  priority  is  commented  out  here  also  */ 

. return  flag; 
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Job:  writebeg.c 

Date:  Mon  Apr  13  20:50:26  1992 


/*  File:  writebeg.c  This  is  write  begin  subroutine  to  set  protection  */ 
/include  <sys/types.h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 
struct  sembuf  WWAIT_NO_READERS  = { 0,  0,  0>; 

struct  sembuf  WREAD_START  - { 0,  1,  Ob- 
struct sembuf  WWRITE_LOCK  = { 1,  1,  0}; 

struct  sembuf  WWRITE_DESIRE  * { 2,  1,  0}; 

struct  sembuf  WIN_PROGRESS_WRITE  - { 2,  -1,  0}; 

int  writebeg(semid) 
int  semid; 

* struct  sembuf  sole_writer[4] ; /*  Four  semaphore  operations  */ 

int  flag; 
void  perror ( ) ; 
tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */  /*  Disabled  here  ! ! */ 
my_tid  * getstid ( ) ; 
my_prio  - getprio(getpid() ) ; 

/*  fast_setprio(my_tid,  31);  */ 

/*  The  fast  setting  of  the  priority  is  commented  out  here  */ 

/*  Make  write  request  by  doing  a semaphore  operation  */ 
flag  » semop( semid,  &WWRITE_DESIRE,  1) ; 
if  (flag  — -1)  { 

perror ("Write-Request  in  writebeg  fails:  ") ; 
return  flag; 

} 

/*  Perform  four  semaphore  operations  */ 

sole  writer[0]  = WWAIT_NO_READERS ; /*  Wait  for  no  more  readers  */ 

sole- wr iter ( 1 ) * WWRITE_LOCK;  /*  preventing  succeeding  readers  */ 

sole- writer[2]  - WREAD_START ; /*  preventing  succeeding  writers  */ 

sole- writer[3]  » WIN_PROGRESS_WRITE;  /*  Cancel  the  write-request  */ 

flag  =“  semop( semid,  sole_writer,  4)  ; /*  Lock  the  critical  section  */ 

if  (flag  — -l)  { 

perror ("Write_Start  in  writebeg  fails:  ") ; 

} 

/*  Lower  the  priority  to  the  normal  */  /*  Not  necessary  since  not  raised  */ 
/*  fast_setprio(my_tid,  my_prio);  */ 

/*  The  lowering  of  the  priority  is  commented  out  */ 
return  flag; 
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Job:  writeend.c 

Date:  Mon  Apr  13  20:50:52  1992 


0*  0*  Q«  0» 


/*  File:  vrriteend.c  This  is  write  end  subroutine  to  reset  write  protection  */ 
/include  <sys/types.h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 
struct  sembuf  WREAD_END  “ { 0,  -1,  0}; 

struct  sembuf  WWRITEJJNLOCK  - { 1,  -1,  0>; 

int  writeend(semid) 
int  semid; 

* struct  sembuf  sole_writer[2] ; /*  Two  semaphore  operations  */ 

int  flag; 
void  perror ( ) ; 

tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */  /*  Not  here  ! ! */ 
my_tid  * getstid() ; 
my_prio  * getprio(getpid() ) ; 

/*  fast_setprio(my_tid,  31);  */ 

/*  The  fast  setting  of  the  priority  is  commented  out  */ 

/*  Perform  the  semaphore  operation  */ 

sole_writer[0]  * WREAD_END;  /*  Allow  writer  in  */ 

sole_wr iter [ 1 ] * WWRITE_UNLOCK;  /*  Allow  reader  in  */ 

flag  =*  semop(semid,  sole_writer,  2);  /*  Unlock  critical  section  */ 

if  (flag  ==  -1)  { 

perror ("writeend  fails:  ") ; 

} 

/*  Lower  the  priority  to  the  normal  */  /*  Not  necessary  since  not  raised  */ 
/*  fast_setprio(my_tid,  my^prio) ; */ 

/*  The  lowering  of  the  priority  is  commented  out  */ 
return  flag; 
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Job:  semsinit.c 

Date:  Mon  Apr  13  20:51:09  1992 


/♦File:  semsinit. c This  is  semaphore  init  subroutine  to  initialize  semaphores*/ 
/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semsinit (semid) 
int  semid; 

{ 

short  initarray [ 3 ] ; 
int  flag; 
void  perror ( ) ; 

initarray[0]  - initarray [1]  - initarray [2]  » 0; 
flag  - semctl (semid,  3,  SETALL,  initarray); 
if  (flag  ==-  -1)  { 

perror ("semsinit  fails:  ") ; 

} 

return (flag) ; 


t 

t 

r rrr  oooo  oooo  ttttt 

rr  r o o o o t 

r o o o o t 

r oooo  t 

r oooo  t t 

r oooo  oooo  tt 


ssss  eeee 

s s e e 

ss  eeeeee 

ss  e 

s s e e 

ssss  sees 


m 

m mm 

ssss 

nun 

m 

m 

s 

m 

m 

m 

ss 

m 

m 

m 

ss 

m 

m 

m 

S 1 

m 

m 

m 

SSSS 

r rrr 

m 

m mm 

V 

V 

rr  r 

mm 

m 

m 

V 

V 

r 

m 

m 

m 

V 

V 

r 

m 

m 

m 

V 

V 

r 

m 

m 

m 

V 

V 

r 

m 

m 

m 

V 

cccc 
c C 

c 
c 

C C 

cccc 


Job:  semsrmv.c 

Date:  Mon  Apr  13  20:51:20  1992 


/*  File:  semsrmv.c  This  is  semaphore  remove  subroutine  to  remove  semaphores  */ 
/include  <sys/types.h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semsrmv(semid) 
int  semid; 

{ 

int  flag; 
void  perror ( ) ; 

flag  = semctl (semid,  3,  IPC_RMID,  0); 
if  (flag  — -1)  { 

perror ("semsrmv  fails:  ") ; 

} 

return (flag) ; 


t 

t 

r rrr  oooo  oooo  ttttt 

rr  r o o o o t 
r oooo  t 

r oooo  t 

r oooo  t t 

r oooo  oooo  tt 


ssss  eeee 

s s e e 

ss  eeeeee 

ss  e 

s s e e 

ssss  eeee 


m 

m mm 

p ppp 

mm 

m 

m 

pp  p 

m 

m 

m 

p p 

m 

m 

m 

p p 

m 

m 

m 

pp  p 

m 

m 

m 

p ppp 

P 

P 

P 


i 


r rrr  ii 

rr  r i 

r i 

r i 

r i 

r iii 


n nnn  ttttt 
nn  n t 

n n t 

n n t 

n n t t 

n n tt 


Job:  semprint.c 

Date:  Mon  Apr  13  20:51:31  1992 


ft  ft 


/*File: semprint. c This  is  semaphore  print  subroutine  to  print  semaphore  values*/ 
/include  <sys/types.h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semprint (semid) 
int  semid; 

{ 

short  outarr ay [ 3 ] ; 
int  flag; 
void  perror ( ) ; 
int  i; 

flag  » semctl (semid,  3,  GETALL,  outarray) ; 
if  (flag  =-  -1)  { 

perror ("semprint  fails:  ") ; 

> 

for  (i“0;  i<3;  ++i)  { 

printf ("Semaphore  %d  has  the  value  of  %d\n",  i,  outarray [ i ]) ; 

> 

return (flag) ; 


Appendix  D-3 


Simulated  RODB 

Concurrent  (Competing),  Reads  and  Writes 

Prevention  of  Preemption  Disabled 
Semaphore  Protection  Disabled 
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Job: 

Date 


read. me 

Wed  Apr  15  19:28:49  1992 


THERE  ARE  THREE  TASKS  RUNNING  IN  THE  SYSTEM:  TWO  READERS  AND  ONE  WRITER 
THEY  ARE  ACCESSING  TO  THE  RODB  COMPONENT  WHICH  IS  NOT  NOW  PROTECTED  BY 
A MECHANISM.  IN  RodbtstFl  ALL  THE  TASKS  HAVE  THE  SAME  PRIORITY  THE 
RESULTS  ARE  IN  FILES  R0DBC0MP1.0UT(R0DBC0MP11.0UT  AND  RODBCOMP12  OUT} 
THE  CORRESPONDING  INPUT  FILES  ARE  FILES  RODBCOMP1.IN  ( RODBCOMP 1 1 ! IN 
AND  RODBCOMP 12 • IN) • 


This  directory  stores  all  the  files  to  build  up  a RODB  "attribute"  components. 
The  protection  mechanism  of  locking  at  the  RODB  level  is  disabled.  The 
prevention  of  preemption  to  protect  the  locking  semaphores  is  also  disabled 
All  of  the  protection  was  formerly  done  inside  four  C functions  which  used 
the  fast_setprio  system  call  and  the  semop  system  call.  There  one  set  of  three 
UNIX  semaphores  formerly  used  in  the  whole  system.  Now,  all  these  system  calls 
are  disabled  and  no  reade/writer  protection  is  provided.  While  this  would 
contribute  to  corrupt  data  items  being  read,  the  test  was  performed  to  see 
the  time  it  would  take  for  competing  reads  and  writes  in  the  "raw".  Of  course 
now  the  overhead  of  calling  the  read  and  write  beginning  and  ending  functions' 
is  of  little  use,  but  they  were  left  in  the  system  to  provide  a method  of 
isolating  the  costs  of  the  protection  mechanisms. 
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Job : rodbtstFl . ada 

Date:  Wed  Apr  15  19:32:17  1992 


"7  This  is  the  reading  and  writing  test  program 
with  TEXT_IO,  CALENDAR,  SYSTEM,  RODB_Component  Data  Types 
TEXT_IO,  CALENDAR,  SYSTEM,  RODB  Component  Data~Typesf 
with  RODB_Test_Datal ; ~ — ' 

procedure  RodbtstFl  is 


RODB_Component ; 
RODB_Component ; 


— Constant  definitions 
ATTR_SIZE  : constant  integer 

NUMBER_0F_TIMES1  : constant  integer 
NUMBER_0F_TIMES2  : constant  integer 
NUMBER_0F_TIMES3  : constant  integer 


:=  200; 

:=  RODB_Test_Datal. Number  Of  Timesl; 
: = RODB_Test_Dat a 1 . Number  Of _Times2 ; 
: = RODB_Test_Datal . Number_Of_Times3 ; 


— Package  instantiation 

package  INT_I0  is  new  TEXT_I0 . INTEGER  10 ( integer) • 
package  FIX_I0  is  new  TEXT_I0 . FIXED  10 (duration) • 
package  RCDT  renames  R0DB_Component  Data  Types  * ' 
package  RODBCP  renames  RODB_Component;  ~ ' 


— task  declaration 
task  Readerl  is 
entry  Finish; 
end  Readerl; 
task  Reader2  is 
entry  Finish; 
end  Reader2 ; 
task  Writer  is 
entry  Finish; 
end  Writer; 


— Variable 

StartJTimel 

Start_Time2 

Start_Time3 

Finish_Timel 

Finish_Time2 

Finish_Time3 

Resultl 

Result2 

Result3 

Addr_Listl 

Addr_List2 

Addr_List3 

Attr_Listl 

Attr_List2 

Attr_List3 

Lengthl 

Length2 

Length3 

Outfile 


definition 

CALENDAR. time; 

CALENDAR. time; 

CALENDAR. time; 

CALENDAR. time; 

CALENDAR. time; 

CALENDAR . t ime ; 
duration; 
duration; 
duration; 

RCDT . Pos_List_Type ( 1 . . ATTR  SIZE) 
RCDT . Pos_List_Type ( 1 . . ATTR  SIZE) 
RCDT. Pos_List_Type ( 1 . .ATTR  SIZE) 
RCDT . Attr_List_Type ( 1 . . ATTR  SIZE) 
RCDT . Attr_List_Type ( 1 . . ATTR  SIZE) 
RCDT . Attr_List_Type ( 1 . . ATTR  SIZE) 
integer  1;  ~ 

integer  l; 

integer  :■  1; 
file_type; 


(0,  others»>0) ; 

(0,  others->0) ; 

(0,  other s»>0) ; 

( (0,200) ,others=>(0, 200) ) 

( (0,200) ,others=>(0,200)  ) ; 
( (0,200) ,others=> (0,200)  ) ; 


— The  body  of  task  readerl 
task  body  Readerl  is 
begin 

start_Timel  CALENDAR. clock; 

for  I in  1. .NUMBER_OF_TIMESl  loop 

end°ioop*,Rea<1— ^ Attrs(Addr_Listl,  Lengthl,  Attr_Listl)  ; 

FinishJTimel  :=■  CALENDAR. clock; 

Resultl  Finish_Timel  - Start_Timel; 


accept  Finish; 
exception 

when  others  =>  ...» 

put_line ( "Task  Readerl  has  an  exception."); 

end  Readerl; 

— The  body  of  task  reader2 
task  body  Reader 2 is 
begin 

Start  Time2  :=  CALENDAR. clock; 
for  I in  1 . . NUMBER_0F_TIMES2  loop 

RODBCP . Read_Attrs ( Addr_List2 , Length2 , Attr_List 2 ) ; 
end  loop; 

Finish  Time2  :=  CALENDAR. clock; 

Resultl  :*  Finish_Time2  - Start_Time2; 

accept  Finish; 
exception 

when  others  *> 

put_line("Task  Reader2  has  an  exception."); 
end  Reader2; 

— The  body  of  task  writer 
task  body  Writer  is 
begin 

Start_Time3  : ■ CALENDAR. clock; 
for  I in  1. . NUMBER_0F_TIMES3  loop 

RODBCP. Wr ite_Attrs (Addr_List3 , Length3,  Attr_List3) ; 
end  loop; 

Finish_Time3  CALENDAR. clock; 

Result3  :«  Finish_Time3  - Start_Time3; 

accept  Finish; 
exception 

when  others  => 

put_line ( "Task  Writer  has  an  exception."); 
end  Writer; 

begin 

— Terminate  gracefully 
Readerl . Finish ; 

Reader2 . Finish; 

Writer. Finish; 

— Write  out  the  results 

create (Outfile,  out  file,  "rodbcompl.out", 

form“>"world~>read,  owner->read_write") 
put_line (Outfile,  "Task  Number_0 ^Iterations  Times"); 

put (Outfile,  "Readerl  ") ; 

INT_IO. put (Outfile,  NUMBER_OF_TIMES 1 ) ; 

FIX_IO. put (Outfile,  Resultl) ; 
new_line (Outfile) ; 
put(Outfile,  "Reader2  ") ; 

INT_IO . put ( Outf i le , NUMBER_OF_TIMES2 ) ; 

FIX_IO. put (Outfile,  Result2); 
new_l ine ( Outf i le ) ; 
put(Outfile,  "Writer  ") ; 

INT_IO . put ( Outfile , NUMBER_OF_TIMES 3 ) ; 

FIX_IO. put (Out file,  Result3); 


new_line(Outfile) ; 
close (Outfile) ; 


end  RodbtstFl; 
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Job : rodbcompl . dat 

Date:  Wed  Apr  15  19:32:46  1992 
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0  100 
1 200 

2 300 

3 400 

4 500 

5 600 

6 700 
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0 false 

1 false 

2 false 

3 false 

4 false 

5 false 

6 false 

7 false 

8 false 

9 false 
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Date:  Wed  Apr  15  19:29:58  1992 
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Job : rodbcompll - out 

Date:  Wed  Apr  15  19:30:08  1992 


Task 
Reader 1 
Reader2 
Writer 


Number_Of_Iterations  Times 
2500  2.12396 

2500  1.71387 

5000  2.13214 


r rrr 

rr  r 

r 

r 

r 

r 


oooo 
o o 

o o 

o o 

o o 

oooo 


oooo 
o o 

o o 

o o 

o o 

oooo 


t 

t 

ttttt 

t 

t 

t 

t t 
tt 


d 

d 

d 


r rrr 

oooo 

ddd  d 

rr  r 

o 

o 

d dd 

r 

o 

o 

d d 

r 

o 

o 

d d 

r 

o 

o 

d dd 

r 

oooo 

ddd  d 

b 

b 

b 


b bbb 

cccc 

oooo 

bb  b 

c c 

o o 

b b 

c 

o o 

b b 

c 

o o 

bb  b 

c c 

o o 

b bbb 

cccc 

oooo 

1 

11 
1 1 


m m mm 

p 

ppp 

1 

sun 

m 

m 

pp 

p 

1 

m 

m 

m 

p 

p 

1 

m 

m 

m 

p 

p 

1 

m 

m 

m 

pp 

p 

1 

m 

m 

m 

p 

ppp 

mu 

P 

P 

P 


rodbcompl2 . in 
: Wed  Apr  15  19:31:08  1992 


Job: 

Date 
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Task 
Reader 1 
Reader2 
Writer 


Number_Of_lterations  Times 
5000  4.06671 

5000  3.75201 

5000  3.30518 
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Job : rodb_component_data_types_ . ada 

Date:  Wed  Apr  15  19:25:00  1992 


— This  package  provides  the  constants,  instantiated  packages 

"7  an<*  ® functions  interfaces  to  C language  for  RODB  COMPONENT 

with  TEXT_IO,  SYSTEM; 

use  TEXT_IO,  SYSTEM; 

package  RODB_COMPONENT  DATA  TYPES  is 


system  calls 
package. 


— Constants 

INT_SIZE 

CHAR_SIZE 

BOOL_SIZE 

FLT_SIZE 

SHMKEY 

SEMKEY 

SHM_SIZE 

CHAR_OFFSET 

BOOL_OFFSET 

FLT  OFFSET 


constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 


- 10; 

« 10; 

- 10; 

- 10; 

- 99; 

- 100; 

= INT_SIZE*4+CHAR_SIZE+BOOL  SIZE+4*FLT  SIZE 
- INT_SIZE*4;  ~ 

* CHAR_OFFSET  + CHAR_SIZE*1; 

= BOOL_OFFSET  + BOOL_SIZE*l; 


— Data  types 

type  Attr_Type (Type_ID  : integer  :=  0)  is  record 
case  Type_ID  is 
when  0 => 

Int_Value  : integer; 
when  1 -> 


Char_Value  : character; 
when  2 -> 

Bool_Value  : boolean; 
when  3 -> 

Flt_Value  : float; 
when  others  => 
null; 
end  case; 
end  record; 

^YP®  Attr_List_Type  is  array ( integer  range  <>) 
type  Pos_List_Type  is  array ( integer  range  <>) 


of  Attr_Type; 
of  integer; 


— Package  instantiation 

package  INT_IO  is  new  TEXT_IO. INTEGER  10 ( integer) ; 
package  BOOL_IO  is  new  TEXT_IO . ENUMERATION  IO (boolean) • 
package  FLT_IO  is  new  TEXT_IO. FLOAT  10 (float); 
function  FINT  is  new  system. fetch_from  address ( integer ) ; 
function  FCHAR  is  new  system. fetch_from  address (character) ; 
function  FBOOL  is  new  system. fetch_from_address (boolean) ; 
function  FFLT  is  new  system. fetch_from  address (float) ; 
procedure  AINT  is  new  system. ass ign_to  address ( integer) ; 
procedure  ACHAR  is  new  system. ass ign_to_address (character) ; 
procedure  ABOOL  is  new  system. ass ign_to  address (boolean) ; 
procedure  AFLT  is  new  system. assign_to_address( float) ; 


— Shared  memory  system  call  interface 
function  SHMGET(KEY  : in  integer; 

SIZE  : in  integer; 

FLAG  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SHMGET) ; 
pragma  INTERFACE_NAME ( SHMGET , M shmget " ) ; 
function  SHMAT ( SHMID  : in  integer; 

SHMADDR  : in  system. address; 

FLAG  ; in  integer)  return  system. address; 

pragma  INTERFACE (C,  SHMAT);  ' 

pragma  INTERFACE_NAME ( SHMAT,  "shmat") ; 


function  SHMDT ( SHMADDR  : in  system. address)  return  integer 

pragma  INTERFACE (C,  SHMDT); 

pragma  INTERFACE_NAME ( SHMDT,  "shmdt") ; 

function  SHMCTL ( SHMID  : in  integer; 

CMD  : in  integer; 

BUFF  : in  system. address)  return  integer 

pragma  INTERFACE (C,  SHMCTL); 
pragma  INTERFACE_NAME ( SHMCTL , " shmct 1") ,* 

— Semaphore  system  call  and  C function  interface 
function  SEMGET (KEY  : in  integer; 

NSEMS  : in  integer; 

FLAG  : in  integer)  return  integer; 

pragma  INTERFACE (C,  SEMGET); 
pragma  INTERFACE_NAME( SEMGET,  "semget"); 
function  SEMSINIT(SEMID  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SEMSINIT) ; 

pragma  INTERFACE_NAME( SEMSINIT,  "semsinit") ; 

function  SEMPRINT ( SEMID  : in  integer)  return  integer; 

pragma  INTERFACE (C,  SEMPRINT); 

pragma  INTERFACE_NAME ( SEMPRINT,  "semprint"); 

function  READBEG (SEMID  : in  integer)  return  integer; 

pragma  INTERFACE (C,  READBEG); 

pragma  INTERFACE_NAME ( READBEG,  "readbeg") ; 

function  READEND (SEMID  : in  integer)  return  integer; 

pragma  INTERFACE (C,  READEND); 

pragma  INTERFACE_NAME (READEND,  "readend"); 

function  WRITEBEG( SEMID  : in  integer)  return  integer; 

pragma  INTERFACE (C,  WRITEBEG) ; 

pragma  INTERFACE_NAME (WRITEBEG,  "writebeg") ; 

function  WRITEEND( SEMID  : in  integer)  return  integer; 

pragma  INTERFACE (C,  WRITEEND) ; 

pragma  INTERFACE_NAME (WRITEEND,  "writeend") ; 

function  SEMSRMV( SEMID  : in  integer)  return  integer; 

pragma  INTERFACE (C,  SEMSRMV) ; 

pragma  INTERFACE_NAME ( SEMSRMV,  ,'semsrmv,')  ; 

end  RODB_Component_Data_Types ; 
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J ob : rodb_component_ . ada 

Data:  Had  Apr  15  19:25:20  1992 


with  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
use  TEXT_IO,  SYSTEM,  Rodb_Component_Data_Types ; 
package  Rodb_Component  is 

— Package  renaming 

package  RCDT  renames  Rodb_Component_Data_Types; 

— Exception  definition 
Shm_Exception  : exception; 

Shm_Outrange  : exception; 

Sem_Exception  : exception; 

— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  ; in  RCDT . Pos_List_Type ; 

Length  : in  integer; 

Attr_List  : in  out  RCDT.Attr_List_Type) ; 

— Write  attributes  to  RODB  components 

procedure  Write_Attrs (Addr_List  : in  RCDT.Pos_List_Type; 

Length  : in  integer; 

Attr_List  : in  RCDT. Attr_List_Type) 

— Print  out  the  semaphore  values 

procedure  Print_Sems; 

— Load  RODB  components  from  a disk  file 

procedure  Load_Comps (Filename  : in  string); 

— Save  RODB  components  to  a disk  file 

procedure  Save_Comps (Filename  : in  string); 

— Shutdown  the  RODB  components 
procedure  Shutdown_Comps ; 


end  RODB  COMPONENT; 


i 


i 


11 

1 

1 

1 

1 

1 

1 

1 

111 


b 
b 
b 

b bbb  ii 

bb  b i 

b b i 

b b i 

bb  b i 

b bbb  i i i 


n nnn 
nn  n 

n n 

n n 

n n 

n n 


J ob : rodb_component . ada 

Date:  Wed  Apr  15  19:25:36  1992 


with  TEXT  10,  CALENDAR,  SYSTEM,  PREEMPTI0N_C0NTR0L,  Rodb_Component_DataJTypes 
use  TEXT~I0,  CALENDAR,  SYSTEM,  PRE EMPTI 0N_C0NTR0L , Rodb_Component_DataJTypes 
package  body  Rodb_Component  is 

— Local  variables 
Shmid  : integer ; 

Shmaddr  : system. address; 

Semid  : integer ; 

— Local  subprograms 
procedure  Load_Ints ( Inf i le 
procedure  Load_Chars ( Infile 
procedure  Load_Bools (Inf ile 
procedure  Load_Flts (Infile 
procedure  Save_Ints (Outf ile 
procedure  Save_Char s ( Out f ile 
procedure  Save_Bools (Outf ile 
procedure  Save_Flts (Outf ile 


in  FILE_TYPE) ; 
in  FILE_TYPE) ; 
in  FILEJTYPE)  ; 
in  FILE_TYPE) ; 
in  FILE_TYPE) ; 
in  FILEJTYPE) ; 
in  FILE_TYPE) ; 
in  FILE  TYPE) ; 


— Read  attributes  from  RODB  components 

procedure  Read  Attrs (Addr_List  : in  RCDT . Pos_List_Type ; 

Length  : in  integer; 

Attr_List  : in  out  RCDT. Attr_List_Type)  is 
Temp  : system. address; 

Flag  : integer; 
begin 

— PREEMPTION_CONTROL . DISABLE_PREEMPTION ; 

Flag  RCDT. READBEG( Semid ) ; 

— PREEMPTION_CONTROL . ENABLE_PREEMPTION ; 
if  Flag  * -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1.. Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr_List (I)  > RCDT.SHM_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp  :*  Shmaddr  + system. offset (Addr_List (I) ) ; 
if  (Addr  List(I)  < RCDT . CHAR_OFFSET)  then 

Attr_Llst(I)  :»  (Type_ID  ->  0,  Int_Value  =>  RCDT. FINT (Temp) ) ; 
elsif  (Addr  List(I)  < RCDT . BOOL_OFFSET)  then 

Attr  List(I)  :=»  (Type_ID  *>  1,  Char_Value  =>  RCDT. FCHAR (Temp) ) ; 
elsif  "(Addr  List(I)  < RCDT . FLT_OFFSET)  then 

Attr  Listjl)  :»  (Type_ID  «>  2,  Bool_Value  =>  RCDT. FBOOL (Temp) ) ; 

else 

Attr_List(I)  (Type_ID  ->  3,  Flt_Value  «>  RCDT. FFLT (Temp) ) ; 
end  if; 
end  loop; 

— delay  10.0; 

— PREEMPTION_CONTROL. DISABLE_PREEMPTION ; 

Flag  :=  RCDT. READEND( Semid ) ; 

— PREEMPTION_CONTROL . ENABLE_PREEMPT I ON ; 
if  Flag  - -1  then 

raise  Sem_Exception; 
end  if; 

end  Read  Attrs; 


— Write  attributes  to  RODB  components 
procedure  Write_Attrs(Addr_List  : in 

Length  : in 
Attr  List  : in 


RCDT . Pos_List_Type ; 
integer; 

RCDT. Attr  List_Type)  is 


Temp  : system. address; 

Flag  : Integer; 
begin 

— PREEMPTION_CONTROL . DISABLE  PREEMPTION ; 

Flag  RCDT . WRITEBEG ( Semid) ; 

— PREEMPTION_CONTROL. ENABLE  PREEMPTION; 
if  Flag  - -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1..  Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr List(I)  > RCDT. SHM  SIZE-1)  then 
raise  Shm_Outrange;  - 1 

end  if; 

Temp  Shmaddr  + system. offset (Addr  List(I)); 
if  (Addr_List (I)  < RCDT. CHAR_OFFSET) 'then 
RCDT . AINT (Temp , Attr  List (I) . Int  Value) ; 
elsif  (Addr_List(I)  < RCDT . BOOL_OFFSET)  then 
RCDT. ACHAR( Temp,  Attr_List(I) .Char  Value); 
elsif  (Addr_List (I)  < RCDT. FLT_OFFSET)  then 
RCDT. ABOOL( Temp,  Attr  List (I) . Bool  Value); 
else  ~ 

RCDT. AFLT( Temp,  Attr  List(I).Flt  Value); 
end  if;  ~ ~ 

end  loop; 

— delay  10.0; 

PREEMPTION_CONTROL. DISABLE  PREEMPTION; 

Flag  RCDT. WRITEEND( Semid) ;~ 

— PREEMPTION_CONTROL. ENABLE  PREEMPTION; 
if  Flag  - -l  then 

raise  Sem_Exception; 
end  if ; 

end  Write_Attrs; 

— Print  out  the  semaphore  values 
procedure  Print_Sems  is 
Flag  ; integer; 
begin 

Flag  RCDT. SEMPRINT( Semid) ; 

if  Flag  ■ -l  then 

raise  Sem_Exception; 
end  if; 

end  Print_Sems; 

— Load  RODB  Components  from  a disk  file. 

— The  structure  of  disk  file  is  as  following; 

Number_Of_lntegers 
Positionl  Integerl 
Position2  Integer 2 
• • • 

“ ~ Number_0f ^Character s 

” Positionl  Characterl 

Position2  Character2 
• • • 

Number_0 f _Boo 1 eans 
Positionl  Booleanl 
Position2  Boolean2 
• • • 

Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 


“ ■“  • • • # 

procedure  Load_Comps (Filename  t in  string)  is 

Infile  : FILE_TYPE; 

Temp  : system. address; 

Flag  : integer; 

begin 

open (Infile,  in_file,  Filename); 

— initialize  RODB  Integer  Component 
for  I in  1. .RCDT.INT_SIZE  loop 

Temp  Shmaddr  + system. offset ( (I~l) *4) ; 

RCDT . AINT ( Temp , 0 ) ; 
end  loop; 

Load_Ints (Infile) ; 

— Initialize  RODB  Character  Component 
for  I in  1. .RCDT.CHAR_SIZE  loop 

Temp  :*  Shmaddr  + system. offset (RCDT. CHAR_OFFSET  + 1-1) ; 
RCDT. ACHAR( Temp,  'X'); 
end  loop; 

Load_Chars (Infile) ; 

— Initialize  RODB  Boolean  Component 
for  I in  1. .RCDT.BOOL_SIZE  loop 

Temp  : = Shmaddr  + system. offset (RCDT. BOOL_OFFSET  + 1-1) ; 
RCDT . ABOOL ( Temp , true ) ; 
end  loop; 

Load_Bools (Infile) ; 

— Initialize  RODB  Float  Component 
for  I in  1 . . RCDT . FLT_SIZE  loop 

Temp  :=  Shmaddr  + system. offset (RCDT. FLT_OFFSET  + (I-l)*4) 
RCDT . AFLT ( Temp , 0.0); 
end  loop; 

Load_Flts( Infile) ; 
close (Inf ile) ; 

Flag  :=■  RCDT. SEMSINIT(Semid)  ; 
if  Flag  - -1  then 

raise  Sem_Exception; 
end  if; 

exception 

when  name_error  *> 

put_line("File  cannot  be  opened."); 
put_line( "Loading  components  fails!"); 
when  data_error  | end_error  “> 

put_line("File  format  is  incompatible."); 
put_line( "Loading  components  fails!"); 
when  Sem_Exception  =*> 

put_line( "Semaphore  cannot  be  initialized."); 
raise  Sem_Exception; 
when  others  => 

put_line ( "Unknown  exception . " ) ; 
put_line( "Loading  components  fails!"); 
end  Load_Comps; 

— Save  RODB  Components  to  a disk  file 


— The  structure  of  the  disk  file  is  as  following: 

— Numb«r_Of_Integers 
Positionl  Integerl 

— Position2  Integer2 

m • • 

Number_Of_Characters 
Positionl  Characterl 
Position2  Character2 
• • • 

Number_Of_Booleans 
Positionl  Booleanl 
Position2  Boolean2 
• • • 

Number_Of _F loat s 
Positionl  Floatl 
Position2  Float2 
• • • 

procedure  Save_Comps( Filename  : in  string)  is 
Outfile  : FILE_TYPE; 
begin 

if  Filename  /-  ""  then 

create (Outfile,  out_file.  Filename, 

S«v._lnt.(0uttil.);  Cor»->"world»>r«ad,  owner->read_vrit«») 

Save_Chars (Outfile) ; 

Save_Bools (Outfile) ; 

Save_Flts (Outfile) ; 
close (Outfile) ; 

else 

Save_lnts(TEXT_lO. standard  output) ; 

Save_Chars (TEXT_IO . standard  output) ; 

Save_Bools (TEXT_IO. standard  output) ; 

Save_Flts(TEXT_IO. standard  output) ; 
end  if;  - 

exception 

when  constraint_error  ■> 

Put_line ("RODB  Components  data  collapsed."); 

Put_line(" Saving  components  fails!"); 
when  others  => 

P^t_line ( "Unknown  exception . " ) ; 
put_line( "Saving  components  fails!"); 
end  Save_Comps ; 

— Shutdown  RODB  Components 
procedure  Shutdown_Comps  is 
Flag  : integer; 
begin 

Flag  RCDT . SHMDT ( Shmaddr ) ; 

if  Flag  ■ -l  then 
raise  Shm_Exception; 
end  if; 

RCDT . SHMCTL ( Shmid , 0,  system. null  address); 
if  Flag  » -l  then  ~ 

raise  Shm  Exception; 
end  if; 

Flag  RCDT . SEMSRMV ( Semid) ; 

if  Flag  - -l  then 
raise  Sem  Exception; 
end  if; 

end  Shutdown_Comps ; 


pragma  page; 

— Load  all  the  integers  from  a disk  file  to  RODB  Integer  Component 
procedure  Load  Ints (Infile  i in  FILE_TYPE)  is 

Length  : Integer; 

Temp_Pos  : integer ; 

Temp_Int  : integer; 

Temp Addr  : system. address; 
begin 

INT_IO. get (Infile,  Length); 

skip_line (Infile) ; 

for  I in  1 . . Length  loop 

INTJCO. get (Infile,  Temp_Pos) ; 

INT_IO. get (Infile,  Temp_Int) ; 
skip  line(Infile) ; 

if  (Temp  Pos  < 0)  or  (Temp_Pos  > RCDT. INT_SIZE-1)  then 
raise  Shm_Outrange ; 
end  if; 

Temp_Addr  :=  Shmaddr  + system. offset (Temp_Pos*4) ; 

RCDT . AINT (Temp_Addr , Temp_Int) ; 
end  loop; 
end  Load_Ints; 

— Load  all  the  charaters  from  a disk  file  to  RODB  Character  Component 
procedure  Load  Chars (Infile  : in  FILE_TYPE)  is 

Length  : Integer; 

Temp_Pos  : integer; 

Temp_Char  : character ; 

Temp_Addr  : system. address; 
begin 

INT_IO . get ( Infile , Length) ; 

skip_line(Inf ile) ; 

for  I in  1 . . Length  loop 

INT_IO . get (Infile,  Temp_Pos) ; 

get(Infile,  Temp_Char) ; — Skip  a space 

get (Infile,  Temp_Char) ; 
skip  line(Inf ile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.CHAR_$IZE-1)  then 
raise  Shm_Outr ange ; 
end  if ; 

Temp_Addr  Shmaddr  + system . offset (RCDT . CHAR_OFFSET+Temp_Pos) ; 
RCDT . ACHAR ( Temp_Addr , Temp_Char) ; 
end  loop; 
end  Load_Chars; 

— Load  all  the  booleans  from  a disk  file  to  RODB  Boolean  Component 
procedure  Load  Bools (Infile  : in  FILE_TYPE)  is 

Length  : Integer; 

Temp_Pos  : integer; 

Temp_Bool  : boolean; 

Temp_Addr  : system. address; 
begin 

INT_I0 . get ( Infile , Length); 

skip_line(Infile) ; 

for  I in  1.. Length  loop 

INT_I0 . get (Infile,  Temp_Pos ) ; 

BOOL_IO.get(Infile,  Temp_Bool) ; 
skip  line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp_Pos  > RCDT.BOOL_SIZE-l)  then 


raise  Shm_Outrange ; 
end  if; 

Temp_Addr  Shmaddr  + system,  offset  (RCDT.  BOOL  OFFSET+Temn  p0«o  • 
RCDT . ABOOL ( Temp_Addr , Temp_Bool) ; * SET+Temp_Pos ) , 

end  loop; 
end  Load_Bools; 

Load  all  the  floats  from  a disk  file  to  RODB  Float  Component 
procedure  Load  Fits (Infile  : in  FILE  TYPE)  is  " 

Length  : integer;  ~ 

Temp_Pos  ; integer ; 

Temp_Flt  : float; 

Temp_Addr  : system. address; 
begin 

INT_IO. get (Infile,  Length); 

skip_line( Infile) ; 

for  I in  1.. Length  loop 

INT_IO. get (Infile,  Temp_Pos) ; 

FLT_IO.get (Inf ile.  Temp  Fit) ; 
skip_line (Infile) ; 

if  (Temp_Pos  < 0)  or  (Temp  Pos  > RCDT.FLT  SIZE-1)  then 
raise  Shm_Outrange ; - ' 

end  if; 

Shmaddr  + system,  offset  (RCDT.FLT  OFFSET+Temo  Pos*4)- 
RCDT . AFLT  ( Temp_Addr , Temp  Fit);  ~ rraai^iemP_*'os*4) , 

end  loop;  ~ 

end  Load_Flts ; 


pragma  page; 


sDB  to  a disk  fiie 

Temp_Addr  : system. address;  — 

begin 

put (Outfile,  "Number  Of  Integers  is:  "); 

Int_IO . put ( Outf i le , RCDT.INT  SIZE); 
new_line (Outfile) ; 
for  I in  1. .RCDT.INT_SIZE  loop 
put (Outfile,  "Integer  number  ") ; 

Int_IO. put (Outfile,  I-i,  width  *>  5) ; 
put (Outfile,  ":"); 

Temp_Addr  :■  Shmaddr  + system. offset( (I-l) *4) • 

Int_IO. put (Outfile,  RCDT. FINT( Temp  Addr) ) ; 
new_line (Outfile) ; 
end  loop; 
end  Save_lnts; 

— Save  all  the  characters  from  RODB  Character  Component  to  a disk  fii« 
procedure  Save_Chars (Outfile  : in  FILE  TYPE)  is 
Temp_Addr  : system. address ; 
begin 

put (Outfile,  "Number  Of  Characters  is:  ") ; 

Int_IO. put (Out file,  RCDT. CHAR  SIZE) ; 
new_line (Outfile) ; 
for  I in  1. .RCDT.CHAR_SIZE  loop 
put (Outfile,  "Character  number  "); 

Int_IO. put (Outfile,  I-l,  width  ->  5) ; 
put (Outfile,  ":"); 

Te®P  A^dr  :-  Shmaddr  + system. offset (RCDT. CHAR  OFFSET  + I-l) ; 
put (Outfile,  RCDT. FCHAR(Temp_Addr) ) ; ~ 


new_line(Outf ile) ; 
end  loop; 
end  Save_Chars; 

gave  all  the  booleane  from  RODB  Boolean  Component  to  a disk  file 

procedure  Save_Bools (Outf ile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put (Outf ile,  "Humber  Of  Booleans  is:  ') ; 

Int_IO. put (Outf ile,  RCDT . BOOL_SIZE) ; 
new  line (Outf ile) ; 
for“l  in  1. .RCDT.BOOL_SIZE  loop 
put(Outfile,  "Boolean  number  "); 

Int_IO. put (Out file,  1-1,  width  =>  5); 

put (Outf ile,  ":");  . 

Temp  Addr  :■  Shmaddr  + system. offset(RCDT.BOOL_OFFSET  + 1-1) ; 
Bool~IO.put (Outf ile,  RCDT. FBOOL(Temp_Addr) ) ; 
new_line( Out file) ; 
end  loop; 
end  Save_Bools; 

Save  all  the  floats  from  RODB  Float  Component  to  a disk  file 

procedure  Save_Flts (Outf ile  : in  FILE_TYPE)  is 

Temp_Addr  : system. address; 
begin 

put (Out file,  "Number  Of  Floats  is  ") ; 

Int_IO. put (Outf ile,  RCDT. FLT_SIZE) ; 
new  line(Outf ile) ; 
for  I in  1 . . RCDT . FLT_SI ZE  loop 
put (Outf ile,  "Float  number  ") ; 

Int_IO.put (Outf ile,  I-l); 
put (Outf ile,  ":"); 

Temp  Addr  :*  Shmaddr  + system. offset (RCDT. FLT_OFFSET  + (I-l) *4) 
Flt_IO . put ( Out f i le , RCDT . FFLT ( Temp_Addr ) ) ; 
new_line( Out file) ; 
end  loop; 
end  Save_Flts; 


pragma  page; 
sgin 

Shmid  :=  RCDT. SHMGET( RCDT. SHMKEY,  RCDT. SHMSIZE,  1023); 
if  Shmid  - -1  then 
raise  Shm_Exception; 
end  if ; 

Shmaddr  RCDT. SHMAT( Shmid,  system. null_addr ess,  0); 

— if  Shmaddr  ■ system. null_addr ess  then 

raise  Shm_Exception; 

— end  if; 

Semid  RCDT. SEMGET (RCDT. SEMKEY,  3,  1023); 
if  Semid  - -1  then 
raise  Sem_Exception; 
end  if; 

— Initialize  the  RODB  Components 
Load_Comps ( "rodbcomp . dat" ) ; 


end  Rodb_Component ; 
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Job:  rodb_test  datal.ada 

Date:  Wed  Apr  15  19:26:35  1992 


rt  rt  rt  ft 


with  TEXT_IO; 
use  TEXT_IO; 

package  RODB_Test_Datal  is 

Number_Of_Timesl  : integer; 

Number_0f_Times2  : integer; 

Number_0f_Times3  : integer; 

package  INT_IO  is  new  TEXT_IO. INTEGER_IO( integer) 

end  RODB_Test_Datal ; 

with  TEXT_IO ; 
use  TEXT_IO; 

package  body  RODB_Test Datal  is 

Infile  : file_type; 

begin  . „v 

open (Inf ile,  in_file,  "rodbcompl. in") ; 

INT  10. get (Infile,  Number_Of_Timesl) ; 

INT  IO.get(Infile,  Number_0f_Times2) ; 
INT_IO.get(Infile,  Number_0f_Times3) ; 
close (Inf ile) ; 
end  RODB  Test  Datal; 
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Job:  semsinit.c 

Date:  Wed  Apr  15  19:35:49  1992 


/♦File:  semsinit. c This  is  semaphore  init  subroutine  to  initialize  semaphores*/ 
/include  <sys/types.h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semsinit (semid) 

int  semid; 

* short  initarray[3] ; 
int  flag; 
void  perror ( ) ; 

initarray[0]  = initarray[l]  = initarray[2]  = 0; 
flag  = semctl (semid,  3,  SETALL,  initarray) ; 
if  (flag  ==  -1)  { 

perror ("semsinit  fails:  "); 

> 

return (flag) ; 
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Job:  readbeg.c 

Date:  Wed  Apr  15  19:33:56  1992 


/*  File:  readbeg.c  This  is  read  begin  subroutine  to  set  reading  protection  */ 
j * protection  now  disabled  for  this  test  */ 

# include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 

struct  sembuf  RREAD START 

struct  sembuf  RWAIT_NO_WRITE_LOCK 
struct  sembuf  RWAIT_NO_WRITE_DESIRE 


- { 0,  l,  0} ; 

= { l,  o,  0}; 

= { 2,  0,  0}; 


int  readbeg (semid) 
int  semid; 

{ struct  sembuf  one_of_n_readers[5] ; /*  Three  semaphore  operations  */ 

int  flag; 
void  perror ( ) ; 

tid_t  my_tid; 
int  my_prio; 


/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  * getstid() ; 

/ *mYfas t°se tpr io^ my^t id^ ^31) ; ' */  /*  Disable  prevention  of  preemption  */ 

/*  Perform  three  semaphore  operations  */  /*  Disable  semaphores  also  */ 

/*  one  of  n readers [0]  - RWAIT  NO  WRITE_LOCK;  */  /*  Wait  for  no  more  writer  */ 

/*  one—of— n— readers [ 1 ] = RWAITlNO_WRITE_DESIRE;*/  /*  Wait  for  no  more  writer  */ 

/*  one—of ~n— readers ( 2 ] = RWAIT_NO_WRITE_LOCK;  */  /*  Wait  for  no  more  writer  */ 

/*  one- of- n-readers [ 3 ] - RWAIT_NO_WRITE_DESIRE ; * / /*  Wait  for  no  more  writer  / 

/*  one—of —n— readers [ 4 ] - RREAD_START ; */  /*  Prevent  writer  in  */ 

/*  flag  --semop( semid,  one_of_n_readers,  5);  */  /*  Lock  the  critical  section  / 

/*  if  (flag  -1)  { 

perror ( "readbeg  fails:  " ) ; 

} */ 

/*  Lower  the  priority  to  the  normal  */  /*  Now,  no  need  to  reenable*/ 

/*  fast_setprio(my_tid,  myjprio) ; */ 


return  flag; 


> 
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Job:  readend.c 

Date:  Wed  Apr  15  19:34:02  1992 


/*  File:  readend.c  This  is  read  end  subroutine  to  reset  protection  */ 

/*  Action  now  disabled  this  is  a dummy  program  */ 

# include  <sys/ types. h> 

# include  <sys/ipc.h> 

# include  <sys/sem.h> 

# include  <sys/sched.h> 

# include  <st.h> 

/*  The  operations  on  the  semaphore  */ 
struct  sembuf  RREAD_END  = { 0,  -1,  0}; 

int  readend ( semid) 
int  semid; 

{ 

int  flag; 
void  perror ( ) ; 
tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */  /*  Now  disabled  */ 

my_tid  = getstid() ; 
my  prio  = getprio(getpid() ) ; 

/*  f ast_setprio (my_tid,  31);  */  /*  Commented  out  */ 

/*  Perform  the  semaphore  operation  */  /*  Now  no  need  */  */ 

/*/  flag  - semop( semid,  &RREAD_END,  1);  */  /*  Unlock  critical  section  / 

/*  if  (flag  =-  -1)  { 

perror ("readend  fails:  ") ; 

} */ 

/*  Lower  the  priority  to  the  normal  */  

/*7  fast_setprio (my_tid,  myjprio) ; */  /*  Now  no  need  since  not  raised  / 

return  flag; 
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Job:  vritebeg.c 

Date:  Wed  Apr  15  19:34:09  1992 


/*  File*  writebeg.c  This  is  write  begin  subroutine  to  set  protection  */ 
/*  Now  protection  disabled,  this  is  dummy  function  */ 

# include  <sys/ types. h> 


/include 
/ include 
/include 
/include 


<sys/ipc.h> 
<sys/sem.h> 
< sy s/ sched . h> 
<st.h> 


{ 0,  0,0}; 
{ 0,  1,  0}; 
{ l,  1,  0> ; 
{ 2,  1,  0}; 
{ 2,  -1,  0}; 


/*  The  operations  on  semaphores  * 
struct  sembuf  WWAIT_NO_READERS 
struct  sembuf  WREAD_S T ART 
struct  sembuf  WWRITE_LOCK 
struct  sembuf  WWRITE_DESIRE 
struct  sembuf  WIN_PROGRESS_WRITE 

int  writebeg (semid) 
int  semid; 

{ struct  sembuf  sole_writer[4] ; /*  Four  semaphore  operations  */ 

int  flag; 
void  perror ( ) ; 
tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */  /*  Not  anymore  l ! */ 
my_tid  * getstid() ; 

/•^fast^setprio^my^tid^1^!)  \ ’ * I /*  No  prevention  of  preemption  */ 

/*  Make  write  request  by  doing  a semaphore  operation  */  /*  Not  now  !!  */ 

/*  flag  ■ semop (semid,  &WWRITE_DESIRE,  1); 
if  (flag  —I)  { 

perror ("Write-Request  in  writebeg  fails:  "); 

} */  /*  This  program  now  does  nothing  constructive  */ 

/*  Perform  four  semaphore  operations  *//*  Disabled!!  */  , 

/*  sole  writer[0]  - WWAIT_NO_READERS ; */  /*  Wait  for  no  more rs  */ 

. . * wwrite  LOCK:  */  /*  preventing  succeeding  readers  / 

!r  2 - WREAD  START;  */  /*  preventing  succeeding  writers  */ 

/*  sole"”wr iter [ 3 ] - WIN_PROGRESS_WRITE;*/  /*  Cancel  the  write-request  */ 

/*  flag--  semop (semid,  sole_writer,  4);  */  /*  Lock  the  critical  sec  / 

/*  if  (flag  — -1)  { 

perror ( "Write_Start  in  writebeg  fails:  ); 

> */ 

/*  Lower  the  priority  to  the  normal  */  /*  Not  necessary  ! */ 

/*  fast_setprio(my_tid,  myjprio) ; */ 

return  flag; 


} 


t 

t 

r rrr  oooo  oooo  ttttt 

rr  r o o o o t 

r o o o o t 

r o o o o t 

r oooo  t t 

r oooo  oooo  tt 


w 

V 

r rrr 

W V 

w 

rr 

w w 

w 

r 

V V 

w 

r 

w v 

V 

r 

ww  ww 

r 

i 

ii 
i 
i 
i 
i 

iii 


t 

t 

ttttt 

t 

t 

t 

t t 
tt 


eeee 
e e 

eeeeee 
e 

e e 

eeee 


eeee 
e e 

eeeeee 
e 

e e 

eeee 


n nnn 
nn  n 

n n 

n n 

n n 

n n 


ddd 
d dd 
d d 
d d 
d dd 
ddd  d 


Job:  writeend.c 

Date:  Wed  Apr  15  19:34:20  1992 


a a a a 


/*  File:  writeend.c  This  is  write  end  subroutine  to  reset  write  protection  */ 
/*  Now  protection  disabled  for  this  test  */ 

/include  <sys/types.h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 

/include  <sys/sched.h> 

/include  <st.h> 

/*  The  operations  on  semaphores  */ 
struct  sembuf  WREAD_END  “ { 0,  ~1,  0}; 

struct  sembuf  WWRITE_UNLOCK  = { 1,  -1,  0}; 

int  writeend(semid) 
int  semid; 

{ struct  sembuf  sole_writer[2] ; /*  Two  semaphore  operations  */ 

int  flag; 
void  perror ( ) ; 
tid_t  my_tid; 
int  my_prio; 

/*  Raise  the  priority  to  prevent  the  preemption  */ 
my_tid  *getstid(); 
myprio  = getprio(getpid() ) ; 

/*  fast_setprio(my_tid,  31) ; */  /*  Disabled  */ 

/*  Perform  the  semaphore  operation  */  /*  Now  no  semops  ! ! */ 

/*  sole  writer [0]  - WREAD_END;  */  /*  Allow  writer  in  */ 

/*  sole- wr iter [ 1 ] - WWRITEJJNLOCK;  */  /*  Allow  reader  in  */ 

/*  flag-*  semop( semid,  sole_writer,  2);*/  /*  Unlock  critical  section  */ 

/*  if  (flag  **  -1)  { 

perror ("wr it eend  fails:  ") ; 

} */ 

/*  Lower  the  priority  to  the  normal  */  /*  No  need  now  !!  */ 

/*  f ast_setprio (my_tid,  myjprio) ; */ 

return  flag; 

} 
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J ob : semsrmv . c 

Date:  Wed  Apr  15  19:35:41  1992 


eeee 
e e 

eeeeee 
e 

e e 

eeee 


m m nun 
mm  m m 
m m m 
m m m 
m m m 
m m m 


ssss 
s s 

S3 

SS 

s s 

ssss 


r rrr 

rr  r 

r 

r 

r 

r 


m m mm 
mm  m m 
m m m 
m m m 
m m m 
m m m 


v 

v 

v 


v 

V 

V 


V V 
V V 
V 


cccc 
c C 

c 
c 

c c 

cccc 


/*  File:  semsrmv.c  This  is  semaphore  remove  subroutine  to  remove  semaphores  */ 
# include  <sys/types.h> 

# include  <sys/ipc.h> 

^include  <sys/sem.h> 
int  semsrmv(semid) 
int  semid; 

{ 

int  flag; 
void  perror(); 

flag  = semctl (semid,  3,  IPC_RMID,  0); 
if  (flag  — -1)  { 

perror ("semsrmv  fails:  ") ; 

> 

return (flag) ; 


Appendix  E 


Concurrent  (Competing)  Reads  and  Writes 


Code  for  demonstrating  the  lack  of  mutual  exclusion  in  a critical  sec- 
tion for  reading/writing  to  a simulated  RODB  component.  The  lack  of 
mutual  exclusion  is  presumably  caused  by  the  non-atomic  nature  of 
the  semop  system-call  algorithm  for  an  array  of  semaphores. 
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Job:  read. me 

Date:  Tue  Apr  14  22:24:53  1992 


This  directory  stores  all  the  files  to  build  up  an  RODB  "attribute”  component 
Tjj®  pro^®?tlon  JJecha”ls®  is  that  locking  is  set  at  the  RODB  level.  During  the 
io  L ?ttin9'  there  1S  N0  Prevention  of  preemption.  WE  ASSUME  A SYSTEM  CALL 
IS  AM  ATOMIC  ACTION.  Assume  there  is  one  set  of  three  UNIX  semaphores  in  the 
whole  system.  Before  actual  reading,  a set  of  THREE  semaphore  operations  will 
be  imposed  on  the  semaphores.  After  actual  reading  one  semaphore  array 
operation  will  be  imposed  on  the  semaphores.  Before  actual  writina  there 
are  two  levels  of  operations:  ™ * 


write-intent  on  one  level  and  write-lock  and  read-lock  on  the  other. 

F°r  write-intent  only  one  semaphore  operation  will  be  imposed  on  the  semaphore 
and  for  write-lock  a set  of  four  semaphore  operations  will  be  ordinarily 
imposed  on  the  semaphores  (i.e.  including  test  of  read-lock  semaphore 
increase  read-lock,  set  write-lock  and  clear  write-intent  semaphore) . 

BUT  ON  LYNX  SEMAPHORE  OPERATIONS,  IF  A PROCESS  EXECUTING  SEMOP  IS  PREEMPTFn 
OR  EVEN  SLEEPS  ON  A SEMAPHORE  EVENT,  THERE  IS  NO  GUARANTEE  PREEMpTED 

THAT  SEMOP  WILL  RESUME  AT  THE  VERY  BEGINNING  OF  THE  SEMOP  ALGORITHM. 

After  actual  writing,  a set  of  two  release-semaphore  operations  will  ordinaril 
be  imposed  on  the  semaphores.  -L-LX  orainaril 

IN  THIS  PROGRAM,  A PAUSE  HAS  BEEN  INTRODUCED  IN  THE  WRITER  "CODE" 

^ THAT  THESE  TWO  OPERATIONS (VIZ . WRITER  LOCK  AND  READER  LOCK)  ARE  NOT  RELEASE 
TEST  SH0WS  Is  FACT  THAT  IF  THE  READER  HAS  SLEPT  ON  THE  WRITER  INTENT 

THE^READERTNOW  TSDAWA^MF?riyjTED  BY  THE  WRITER  AND  N0W  HAD  BEEN  RELEASED  AND 
THE  READER  NOW  IS  AWAKENED,  IT  SHOULD,  BUT  WILL  NOT  GO  BACK  TO  THF  RFrTNWTur 

T0  CHECK  THE  STATUS  °F  the  writeS  lS?k  s^apSore  S ?T 

uffU^fmWHERE  IT  LEFT  0FF  AND  ONLY  CHECKS  THE  WRITER  INTENT  SEMAPHORE  WHICH 

££*  mVE  B0™  A READER 

is  done  a menu  will  appear  for  each  process  on  its  respective  terminal  screen 
One  process  should  choose  option  "4"  to  load  the  shared  memory  and  preslthe 

fCR>)*  The  question  is  then  "asked"  for  the  name  ofPthe 
file  from  which  to  load  the  contents  of  the  shared  memory.  The  simplest  is 

!?”aa  I???’*  Sii;C8  ‘?ere  is  a default  data  file  which  will  bi  loaded  by 
hv  eoiarfi  Enter  key  (i,e,<CR>).  Once  this  is  done  the  memory  may  be  viewed 
^ SfieCwing  °P^ion  3*  Then,  when  the  menu  appears  again,  this  first  terminal 
should  choose  the  option  "l"  to  read  a list  of  attributes  followed  by  <cr>. 

When  the  question  is  asked  "how  many"  the  simplest  answer  is  to  type  1 <CR> 

The  question  will  then  be  raised  as  to  the  address  to  be  "read",  the  simplest 
answer  is  to  type  the  number  "0"  (without  the  quotes)  BUT  DO  NOT  PRESS  "Enter" 
Then  set  up  the  next  terminal  by  running  another  copi  of  rodb  test?  fnd  Moose' 

"asked" "f or  "how°manv"e  fhliSt  °f  a^tributes  <CR>‘  »•».  when’the  question  ?s 

J nany"^ the  answer  is  to  type  1 <CR>.  As  before  the  address 

question  will  be  asked.  Type  m the  number  "0"  as  before  followed  bv  <CR> 
q“aatl°n  “111  **>•"  be  asked  for  the  value  to  be  written  ioS  may  type 
some  integer  such  as  200  (the  number  100  is  the  default  at  address  0) 

$£2  R?n,rPTh"CR^°r  Erer  !LThen  ?tart  the  fhifl  process** rom  the 
THIRD  terminal.  This  time  choose  the  option  "1"  again  to  read.  Aaain  select 

one  (1)  attribute  and  again  select  address  "0"  BUT  DO  NOT  TYPE  <CR>. 

terminal  ?ne  U>  an<i  press  Enter  (<CR>) . Right  after  that 
(less  that  five  seconds  ) press  Enter  (<CR>)  on  terminal  two  (2). 

After  that  (less  than  five  but  more  than  two  seconds)  press  MEnterM 
on  terminal  three  (3).  Clearly  the  first  process  will  encounter  the 


na chores  before  process  two  and  will  lock  out  process  two  since  it  will 
'rease  the  reader  semaphore.  Process  two  (2)  will  set  the  write- intent 
naphore  but  will  block  on  the  reader  semaphore.  Process  three  (3)  will 
-t  the  write-lock  semaphore  and  find  it  NOT  set  (Process  one  (D  is 
ucS?ed  to  stay  in  the  -reader-critical  section  about  ten  seconds  so 
» writer  will  be  "locked  out".  HOWEVER,  Process  three  (?)  will  find  the 
[te- intent  semaphore  set  so  it  will  "sleep"  on  the  event  that  the 
ite-intent  semaphore  is  "cleared".  Meanwhile  eventually  — after  ten 
^ ^nte  the  first  reader  finishes  and  "clears"  the  reader  semaphore. 
^Sfatilv  ^he  ^fsecon^priceSs  (2)  will  wake  to  find  the  reader  semaphore 
Th i swr it er °pr oces s (2)  will  then  set  the  "write-lock"  semaphore 
t will  release  the  write-intent  semaphore  so  as  to  allow  higher  P^i°rJ^ 

jus  =sus  sr  s.-bujjs- 

j 4.or«iriatfi  Process  two  (2)#  which  started  before  process  three  (3)  is 
ocked  at  its  "pause"  statement  just  before  accessing  the  shared  memory, 
ocess  three  ( 3)^f inishes  even  though  it  should  be  blocked  from  entering 
f the  "write  lock"  semaphore  set  by  process  two  (2) . 

mce  the  Lynx  semop  algorithm  does  not  meet  the  System  V 
id  further  even  if  it  did  in  the  non-preemptive  case,  it  might  fail 
ider  the  real-time  preemptive  case.  That  is  to  say,  if  the  process 
>es  not  sleep  but  is  preempted  during  the  execution  of  a?9orithm  semop 
xen  it  resumed  it  would  not  know  that  it  had  been  preempted  and  would 
jntinue  on.  Thus  the  same  scenario  could  haPPe?  a?  a£?^*  • {y 

jader  process  did  not  sleep  but  was  preempted  by  an  high  priority 
riter  just  before  it  increased  the  "read- lock"  semaphore. 
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Job:  rodb_test7 . ada 

Date:  Tue  Apr  14  22:25:16  1992 


rt  rt 


] This  is  main  program  for  Test  of  Reader-Writer  mutex  problem  for  the  RODB 
Component.  The  RODB  Component  is  represented  by  a small  Shared  Memory 
Seoment  which  is  set  up  by  functions  and  procedures  in  package  RODBCP  which 
is9^6" rename " for  package  RODB  COMPONENT_DATA_TYPES . Most  of  these  RODBCP 
functions  are  Ada  names  for  C library  functions  and  UNIX  System  Calls. RODBCP 
operations  and  the  accessing  of  the  RODB  Shared  Memory  segment, 
e TEXT  10,  SYSTEM,  RODB_Component_Data_Types , RODB_Component ; 
ocedure  Rodb_Test7  is 
ATTR  SIZE  : constant  integer  :=  20; 
package  RCDT  renames  RODB_Component_Data_Types ; 
package  RODBCP  renames  RODB_Component ; 

Length  : integer ; 

Filename  : string(l. . 13) ; 

File  Len  : integer; 

Addr  List  : RCDT . Pos_List_Type  ( 1 . . ATTR_SIZE)  ,* 

Attr_List  : RCDT . Attr_List_Type ( 1 . . ATTR_SI ZE) ; 

Choice  : integer; 


— Input  a list  of  addresses  at  the  unit  of  bytes 

procedure  Input  Addr  List (Addr_List  • in  out  RCDT.Pos_List_Type; 

Length  : in  integer)  is 

begin 

for  I in  1 . . Length  loop 
put ( "Address  number  ") ; 

INT_IO . put ( I , width=>3 ) ; 
put ( " : " ) ; 

INT_IO . get ( Addr_List ( I ) ) ; 
end  loop; 

end  Input_Addr_List ; 

— Input  a list  of  attributes  according  to  their  addresses 
procedure  Input  Attr_List (Attr_List  : in  out  RCDT. AttrListType; 

Length  : in  integer; 

Addr_List  : in  RCDT.Pos_List_Type)  is 

Anlnt  : integer; 

A_Char  : character; 

A_Bool  : boolean; 

A Fit  : float; 
begTn 

for  I in  1 . . Length  loop 

if  (Addr_List (I)  < RCDT. CHAR_0FFSET)  then 
put ("Enter  an  attribute  integer:  ") ; 

INT  IO.get (An_Int) ; 

Attr  List (I)  :=  (Type_ID  =>  0,  Int_Value  =>  An_Int) ; 

elsif  lAddr_List(I)  < RCDT . B00L_0FFSET)  then 
put ("Enter  an  attribute  character:  "); 
get (A  Char) ; 

Attr  List (I)  :=  (Type_ID  =>  1,  Char_Value  =>  A_Char) ; 

elsif  jAddr_List(I)  < RCDT . FLT_OFFSET ) then 
put ("Enter  an  attribute  boolean:  ") ; 

BOOL  10 . get ( ABool ) ; 

Attr”List(I)  :=  (Type_ID  =>  2,  Bool_Value  =>  A_Bool) ; 
else 

put ("Enter  an  attribute  float:  ") ; 

FLT  IO.get (A_Flt) ; 

Attr_List(I)  :=  (Type_ID  =>  3,  Flt_Value  =>  A_Flt) ; 
end  if; 
end  loop; 

end  Input_Attr_List; 


Output  a list  of  Attributes  according  to  their  addresses 
procedure  Output_Attr_List (Attr_List  : in  RCDT.Attr  List  Type- 
begin  Len*th  • in  integer)  Is  " 


for  X in  1 . . Length  loop 
put ( "Attribute  number" ) ; 
INT_IO . put ( I , width  =>  3); 
put("  is  ") ; 

case  Attr_List (I) .Type_ID  is 
when  0 => 


put ("Integer:  "); 

INT_IO.put(Attr_List(I) .Int  Value) ; 
when  1 =>  ~ 

put ( "Character : "); 
put (Attr_List (I) . Char_Value) ; 
when  2 => 

put ("Boolean:  "); 

BOOL_IO . put ( Attr_List ( I ) .Bool  Value) ; 
when  3 =>  ~ 

put ("Float:  "); 

FLT_IO . put ( Attr_List ( I ) .Fit  Value) ; 
when  others  => 
null; 
end  case; 
new_line; 
end  loop; 

end  Output_Attr_List; 


begin 

loop 

Pu-*-_^ine ( M 1 Read  a list  of  attributes"); 

put  liner2 Write  a list  of  attributes"); 

Put_line(M3  — print  out  the  shared  memory”); 

line ( *'4— — — — Load  the  shared  memory"); 

put_l ine  ( " 0 Exit " ) ; 

put("Input  your  selection:  ") ; 

INT_IO. get ( Choice) ; 
skip_line; 
case  Choice  is 
when  0 => 
exit  ; 
when  1 => 


put ("How  many  attributes  do  you  want 
INT_IO . ge t ( Length ) ; 
Input_Addr_List(Addr_List,  Length) ; 
RODBCP.Read_Attrs(Addr  List,  Length, 
Output_Attr_List (Attr_List , Length) ; 
when  2 => 


Attr_List) ; 


put ("How  many  attributes  do  you  want:  ") • 

INT_IO. get (Length) ; ' 

Input_Addr_List (Addr_List,  Length) ; 
Input_Attr_List (Attr_List , Length,  Addr  List); 
RODBCP.Write_Attrs(Addr_List,  Length,  Attr  List) ; 
when  3 — > — 


put("Enter  the  filename  to  send  to(none  to  screen) : ") • 
get_lme (Filename,  File_Len) ; ’ 1 

RODBCP . Save_Comps (Filename (l. .File  Len) ) ; 
when  4 =>  -••• 

put ("Enter  the  filename  to  load  from (none  from  rodbcomp.dat) : 


get_line (Filename,  File_Len) ; 
if  (File_Len  /=  0)  then 

RODBCP.Load_Comps(Filename(l. .File_Len) ) ; 

else 

RODBCP . Load_Comps ( "rodbcomp . dat" ) ; 
end  if ; 

when  others  => 

put 1 ine ( " Input  error ! " ) ; 

end  case; 
end  loop; 

RODBCP . Shutdown_Comps ; 
ception 

when  Shm_Exception  => 

pUt_l ine ("Shared  memory  not  accessible.  ) ; 
when  Shm_Outr ange  => 

put  line ("Shared  memory  out  of  range.  ) ; 
when  Sem_Exception  => 

put_l ine ("Semaphores  not  accessible."); 
id  Rodb  Test7; 
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Job:  rodb_component_data_types  .ada 

Date:  Tue  Apr  14  22:25:41  1992  ~ 


This  package  provides  the  constants,  instantiated 
and  C functions  interfaces  to  C language  for  RODB 
th  TEXT  10,  SYSTEM; 


e TEXT  10,  SYSTEM; 

ckage  RODB_COMPONENT_DATA_TYPES  is 


packages,  system  calls 
COMPONENT  package. 


— Constants 

INT_SIZE 

CHAR_SIZE 

BOOL_SIZE 

FLT_SIZE 

SHMKEY 

SEMKEY 

SHM_SIZE 

CHAR_OFFSET 

BOOL_OFFSET 

FLT  OFFSET 


constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 
constant  integer 


10; 


10; 

10; 

10; 

99; 

100; 

INT  SIZE*4+CHAR  SIZE+BOOL_SIZE+4*FLT_SIZE 


INT_SIZE*4; 

CHAR_OFFSET  + CHAR_SIZE*1; 
BOOL  OFFSET  + BOOL_SIZE*l; 


” L/Cl  wCI  , - 

type  Attr_Type (Type_ID  : integer  :=  0)  is  record 
case  Type_ID  is 
when  0 => 

Int_Value  : integer; 
when  1 => 

Char_Value  : character; 
when  2 => 

Bool_Value  : boolean; 
when  3 => 

Flt_Value  : float; 
when  others  => 

null; 
end  case; 


end  record;  . , . 

type  Attr  List_Type  is  array (integer  range  <>) 
type  Pos_List_Type  is  array ( integer  range  <>) 


of  Attr_Type ; 
of  integer; 


— Package  instantiation  . . . 

package  INT  10  is  new  TEXT_I0. INTEGER_IO( integer) , 
package  BOOL  10  is  new  TEXT_IO . ENUMERATION_IO (boolean) ; 
package  FLT  10  is  new  TEXT_I0. FL0AT_I0 (float) ; 

function  FINT  is  new  system*  fetch-f^om-ad^ess(;Jn5®^l;T.v  . 
function  FCHAR  is  new  system. fetch_from_address (character) , 
function  FBOOL  is  new  system. fetch_from_address (boolean) ; 
function  FFLT  is  new  system. f etch_from_address ( float) ; 
procedure  AINT  is  new  system. assign.to  address (integer) ; 
procedure  ACHAR  is  new  system. assign_to_address (character) , 
procedure  ABOOL  is  new  system. assign_to_address(boolean) , 
procedure  AFLT  is  new  system. ass ign_to_addr ess ( float) ; 


— Shared  memory  system  call  interface 
function  SHMGET (KEY  : in  integer; 

SIZE  : in  integer; 

FLAG  : in  integer)  return  integer; 
pragma  INTERFACE (C,  SHMGET) ; 
pragma  INTERFACE_NAME ( SHMGET , "shmget") ; 
function  SHMAT ( SHMID  : in  integer; 

SHMADDR  : in  system. address; 

FLAG  : in  integer)  return  system. address; 

pragma  INTERFACE (C,  SHMAT); 

pragma  INTERFACE_NAME ( SHMAT , "shmat"); 


function  SHMDT ( SHMADDR  : in  system. address)  return  integer- 
pragma  INTERFACE (C,  SHMDT) ; integer, 

pragma  INTERFACE_NAME ( SHMDT , "shmdt”) • 
function  SHMCTL ( SHMID  : in  integer;  ' 

CMD  : in  integer; 

BUFF  : in  system. address)  return  inteaer* 

pragma  INTERFACE (C,  SHMCTL);  integer, 

pragma  INTERFACE_NAME ( SHMCTL , " shmct 1 " ) ; 

— Semaphore  system  call  and  C function  interface 
function  SEMGET (KEY  : in  integer; 

NSEMS  : in  integer; 

FLAG  : in  integer)  return  integer; 

pragma  INTERFACE (C,  SEMGET);  integer, 

pragma  INTERFACE_NAME( SEMGET,  "semget") • 

function  SEMSINIT ( SEMID  : in  integer)  return  integer- 
pragma  INTERFACE (C,  SEMSINIT);  integer, 

pragma  INTERFACE_NAME (SEMSINIT,  "semsinit") • 

™^°™S^!?™SSEMID  : in  inte9er)  return ' integer ; 
pragma  INTERFACE (C,  READBEG) ; * 

pragma  INTERFACE_NAME (READBEG,  "readbeg")- 

function  READEND ( SEMID  : in  integer)  return  integer- 
pragma  INTERFACE (C,  READEND);  integer, 

pragma  INTERFACE_NAME (READEND,  "readend") • 

function  WRITEBEG( SEMID  ; in  integer)  return  integer- 
pragma  INTERFACE (C,  WRITEBEG) ; integer, 

pragma  INTERFACE_NAME (WRITEBEG,  "writebeg'M  • 

function  WRITEEND (SEMID  ; in  integer)  returA  integer- 
pragma  INTERFACE (C,  WRITEEND);  integer, 

pragma  INTERFACE_NAME (WRITEEND,  "writeend") • 

function  SEMSRMV (SEMID  : in  integer)  returA  integer- 
pragma  INTERFACE (C,  SEMSRMV);  integer, 

pragma  INTERFACE_NAME ( SEMSRMV,  "semsrmv") ; 
end  RODB_Component_Data_Types ; 
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Job : r odb_component_ . ada 

Date:  Tue  Apr  14  22:25:57  1992 


with  TEXT_IO,  SYSTEM,  Rodb_Component  Data  Types* 
use  TEXT_IO,  SYSTEM,  Rodb_Component—Data— Types • 
package  Rodb_Component  is  "" 


— Package  renaming 

package  RCDT  renames  Rodb_Component_Data  Types; 

— Exception  definition 
Shm_Exception  : exception; 

Shm_Outrange  : exception; 

Sem_Exception  : exception; 


— Read  attributes  from  RODB  components 

procedure  Read_Attrs (Addr_List  : in  RCDT.Pos_List  Type; 

Length  : in  integer;  ~ 
Attr_List  : in  out  RCDT.Attr_List_Type) ; 

Write  attributes  to  RODB  components 
procedure  Write_Attrs (Addr_List  : in  RCDT.Pos_List  Type; 

Length  : in  integer;-  — 

Attr_List  : in  RCDT.Attr_List_Type) 


Load  RODB  components  from  a disk  file 
procedure  Load_Comps (Filename  : in  string); 


— Save  RODB  components  to  a disk  file 
procedure  Save_Comps (Filename  : in 


string) ; 


— Shutdown  the  RODB  components 
procedure  Shutdown_Comps ; 


end  RODB_COMPONENT; 
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Job : rodb_component . ada 

Date:  Tue  Apr  14  22:37:48  1992 


with  TEXT_IO,  CALENDAR,  SYSTEM,  Rodb  Component  Data  Types; 
use  TEXT_IO,  CALENDAR,  SYSTEM,  Rodb  Component  Data- Types • 
package  body  Rodb_Component  is  ~ ~ 


— Local  variables 
Shmid  : integer; 

Shmaddr  : system. address; 
Semid  : integer; 


— Local  subprograms 
procedure  Load_Ints (Inf ile 
procedure  Load_Chars (Inf ile 
procedure  Load_Bools (Inf ile 
procedure  Load_Flts (Inf ile 
procedure  Save_Ints (Outf ile 
procedure  Save_Chars (Outf ile 
procedure  Save_Bools (Outf ile 
procedure  Save_Flts (Outf ile 


in 

in 

in 

in 

in 

in 

in 

in 


FILE_TYPE) 

FILEJTYPE) 

FILETYPE) 

FILEJTYPE) 

FILEJTYPE) 

FILETYPE) 

FILEJTYPE) 

FILETYPE) 


in 


RCDT . Pos_List_Type ; 
integer;  ~ 


in  out  RCDT . Attr_Lis t_Type ) is 


or  (Addr_List (I)  > RCDT.SHM_SIZE-1)  then 


— Read  attributes  from  RODB  components 
procedure  Read_Attrs (Addr_List  ; in 

Length 
Attr_List 

Temp  : system. address; 

Flag  : integer; 
begin 

Flag  :=  RCDT. READBEG (Semid) ; 
if  Flag  = -l  then 
raise  Sem_Exception; 
end  if ; 

for  I in  l . . Length  loop 
if  (Addr_List (I)  < 0) 
raise  Shm_Outrange ; 
end  if; 

Temp  ;=  Shmaddr  + system. offset (Addr  List(I)); 

If  (Addr^List (I)  < RCDT . CHAR_OFFSET)  then 

Attr  List(I)  :=  (Type_ID  =>  0,  Int  Value  =>  RCDT. FINT( Temp n • 
elsif  (Addr_List (I)  < RCDT . BOOL_OFFSET)  then  P ' 

=>  lf  char_Value  *>  RCDT.  FCHAR( Temp)  ) ; 
elsif  (Addr_Llst (I)  < RCDT. FLT_OFFSET)  then  V 

elsetr_LiSt^1^  (Type-ID  *>  2/  Bool_Value  =>  RCDT. FBOOL( Temp) ) ; 

endtif‘:'LlSt(I)  I=  ^Type-ID  =>  3'  Flt_Value  =>  RCDT. FFLT (Temp) ) ; 

end  loop ; 
delay  10.0; 

Flag  :=  RCDT. READEND (Semid) ; 
if  Flag  = -l  then 
raise  Sem_Exception; 
end  if; 

end  Read_Attrs; 


Write  attributes  to  RODB  components 
procedure  Write_Attrs (Addr_List  : 


Length 

Attr_List 

Temp  ; system . address ; 

Flag  ; integer; 
begin 

Flag  :=  RCDT . WRITEBEG (Semid); 


in  RCDT. Pos_List  Type; 

in  integer ; — 

in  RCDT.Attr_List_Type)  is 


if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

for  I in  1 . . Length  loop 

if  (Addr_List (I)  < 0)  or  (Addr_List (I)  > RCDT . SHM_S I Z E- 
raise  Shm_Outrange ; 
end  if; 

Temp  :=  Shmaddr  + system. offset (Addr_List (I) ) ; 
if  (Addr_List (I)  < RCDT . CHAR_OFFSET)  then 
RCDT. AINT (Temp,  Attr_List(I) .Int_Value) ; 
eisif  (Addr_List (I)  < RCDT. B00L_0FFSET)  then 
RCDT. ACHAR( Temp,  Attr_List(I) .Char_Value) ; 
eisif  (Addr_List (I)  < RCDT. FLT_OFFSET)  then 
RCDT . ABOOL (Temp , Attr_List (I) • Bool_Value) ; 
else 

RCDT. AFLT (Temp,  Attr_List(I) .Flt_Value) ; 
end  if; 
end  loop; 
delay  10.0; 

Flag  :=  RCDT.WRITEEND(Semid) ; 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

end  Write_Attrs; 

— Load  RODB  Components  from  a disk  file. 

— The  structure  of  disk  file  is  as  following: 

Number_Of_Integers 
Positionl  Integerl 

— Position2  Integer2 

• • • 

Number_Of_Characters 

— Positionl  Character 1 

Position2  Character2 

“ • • • 

Number_Of_Booleans 

— Positionl  Booleanl 

Position2  Boolean2 
• • • 

— Number_Of_Floats 

— Positionl  Floatl 

Position2  Float2 

""  • • • t # 

procedure  Load_Comps (Filename  : in  string)  is 

Infile  : FILEJTYPE; 

Temp  : system. address; 

Flag  : integer; 

begin 

open (Infile,  in_file,  Filename); 

— Initialize  RODB  Integer  Component 
for  I in  1. .RCDT.INT_SIZE  loop 

Temp  :=  Shmaddr  + system. offset( (1-1) *4) ; 

RCDT . AINT ( Temp , 0 ) ; 
end  loop; 

Load_Ints (Infile) ; 

— Initialize  RODB  Character  Component 
for  I in  1. .RCDT.CHAR_SIZE  loop 


then 


Temp  :=  Shmaddr  + system. of f set (RCDT. CHAR  OFFSET  + 
RCDT . A CHAR ( Temp , 'X');  - 

end  loop; 

Load_Chars (Infile) ; 


Initialize  RODB  Boolean  Component 
for  I in  1. .RCDT.BOOL_SIZE  loop 

Temp  :=  Shmaddr  + system. offset (RCDT. BOOL  OFFSET  + 
RCDT. ABOOL( Temp,  true); 
end  loop ; 

Load_Bools (Infile) ; 

— Initialize  RODB  Float  Component 
for  I in  1 . . RCDT . FLT_SI ZE  loop 

Temp  :=  Shmaddr  + system. offset (RCDT. FLT  OFFSET  + ( 
RCDT. AFLT (Temp,  0.0);  “ 1 

end  loop; 

Load_Flts (Infile) ; 
close (Infile) ; 

Flag  :=  RCDT. SEMSINIT(Semid) ; 
if  Flag  ” -l  then 
raise  Sem  Exception; 
end  if; 


exception 

when  name_error  => 

Put_line(MFile  cannot  be  opened."); 

Put_line( "Loading  components  fails!"); 
when  data_error  | end  error  => 

Put_line("File  format  is  incompatible."); 
Put_line( "Loading  components  fails!");  ' 
when  Sem_Except i on  =>  ’ 

Put_line(" Semaphore  cannot  be  initialized.")* 
raise  Sem_Exception;  ' 

when  others  => 

Put_line ( "Unknown  exception . " ) ; 
put_line ( "Loading  components  fails ! " ) ; 
end  Load_Comps ; 

Save  RODB  Components  to  a disk  file 
— The  structure  of  the  disk  file  is  as  followina 
Number_Of_lntegers 
Positionl  Integerl 
Position2  Integer2 
• • • 

Number_Of_Characters 
Positionl  Characterl 
Position2  Character2 
• • • 

”**  Number_Of_Booleans 
Positionl  Booleanl 
Position2  Boolean2 


Number_Of_Floats 
Positionl  Floatl 
Position2  Float2 
• • • 

procedure  Save_Comps (Filename  : in 


string)  is 


1-1)  ; 


1-1)  ; 


I-l) *4 ) ; 


Outfile  : FILEJTYPE; 
begin 

if  Filename  /=  HH  then 

create (Outfile 9 out  filef  Filename,  . . 

f orm=>"world=>read,  owner— >read_wnte  ) , 

Save_Ints (Outfile) ; 

Save_Chars (Outfile) ; 

Save_Bools (Outfile) ; 

Save_Flts (Outfile) ; 
close (Outfile) ; 

else  , ^ . . 

Save  Ints (TEXT_IO. standard_output) ; 

Save  Chars (TEXT_IO . standard_output ) ; 

Save  Bools (TEXT_IO . standard_output ) ; 

Save_Flts (TEXT_IO. standard_output) ; 
end  if; 
exception 

when  constraint_error  => 

put  line ("RODB  Components  data  collapsed.  ); 
put“line(" Saving  components  fails!"); 
when  others  —> 

put_line ( "Unknown  exception . " ) ; 
put_line( "Saving  components  fails!"); 
end  Save_Comps; 


— Shutdown  RODB  Components 

procedure  Shutdown Comps  is 

Flag  : integer; 
begin 

Flag  : * RCDT . SHMDT ( Shmaddr ) ; 
if  Flag  = -1  then 

raise  Shm_Exception; 

Flag1 :=  RCDT. SHMCTL ( Shmid , 0,  system. null_address) ; 
if  Flag  = -1  then 

raise  Shm_Exception; 
end  if; 

Flag  :=  RCDT. SEMSRMV(Semid) ; 
if  Flag  = -1  then 

raise  Sem_Exception; 
end  if; 

end  Shutdown  Comps; 


pragma  page; 

— Load  all  the  integers  from  a disk  file  to  RODB  Integer  Component 
procedure  Load  Ints (Infile  : in  FILE_TYPE)  is 
Length  : Integer; 

Temp_Pos  : integer ; 

Temp_Int  : integer; 

Temp_Addr  : system. address; 
begin 

INT_IO.get (Inf ile,  Length) ; 

skip_line (Infile) ; 

for  I in  1 . . Length  loop 

INT_IO . get ( Inf ile,  Temp_Pos ) ; 

INT_IO. get (Infile,  Temp_Int) ; 

tflT^Pos'^o!  'or  (Temp_Pos  > RCDT.  INT_SIZE-1)  then 
raise  Shm  Outrange; 


— Skip  a space 


end  if; 

Temp_Addr  :=  Shmaddr  + system. offset (Temp  Pos*4) • 

RCDT . AINT ( Temp  Addr,  Temp  Int) ; ~ '' 

end  loop;  “ 

end  Load_Ints; 

p^ocedurfLS%S?sUnfnfrin  FILE  Character  Co*Ponent 

Length  : integer; 

Temp_Pos  : integer ; 

Temp_Char  : character; 

Temp_Addr  : system. address; 
begin 

INT_IO . get (Infile,  Length); 

skip_line (Infile) ; 

for  I in  1 . . Length  loop 

INT_IO.get (Inf ile,  Temp_Pos) ; 
get (Infile,  Temp_Char) ; 
get (Infile,  Temp_Char) ; 
skip_line (Infile) ; 

if  (Temp  Pos  < 0)  or  (Temp_Pos  > RCDT. CHAR  SIZE-1)  then 
raise  Shm  Outrange;  - * tnen 

end  if; 

V&tSLZJ&SZ.  +T:^t^,?“Set<RCDT'CH«<-OFfSE^Tenp_PoS,  ; 

end  loop;  ~ ' 

end  Load_Chars; 

Load  all  the  booleans  from  a disk  file  to  nnnn  nnni . , , 

procedure  Load^Bools (Inf ile  : in  FILE  TYPE)  is  mponen 

Length  : integer;  — 

Temp_Pos  : integer; 

TempBool  : boolean; 

Temp_Addr  : system. address; 
begin 

INT_IO.get (Inf ile,  Length) ; 
skipline (Infile) ; 
for  I in  1 . . Length  loop 

INT_IO. get (Infile,  Temp  Pos); 

BOOL_IO. get (Infile,  Temp  Bool) ; 
skip_line (Infile) ; 

if  (Temp  Pos  < 0)  or  (Temp_Pos  > RCDT. BOOL  SIZE-l)  then 
raise  Shm  Outrange;  - ; 

end  if; 

* = shmaddr  + system,  offset  (RCDT.  BOOL  OFFSET+Temp  Post  • 
RCDT. ABOOL(Temp_Addr,  Temp  Bool)  ; ^.wrMitienipjos), 

end  loop;  ~ 

end  Load_Bools ; 

lL.}i  i»  **•  Component 


procedure  Load^Flts (Inf ile  : in 
Length  : Tnteger ; 

Temp_Pos  : integer ; 

Temp_Flt  : float; 

TempAddr  : system. address; 
begin 

INT_IO.get (Inf ile.  Length); 

skip_line( Infile) ; 

for  I in  l . . Length  loop 

INT_IO. get (Infile,  Temp_Pos) ; 


FILETYPE)  is 


FLT_IO . get (Infile,  Temp_F It ) ; 

S^TempIpos'^o) ’'or  <Temp_Pos  > RCDT.FLT_SIZE-1)  then 
raise  Shm_Outrange ; 

Temp^Addr  Shmaddr  + system . of f set ( RCDT . FLT_OFFSET+Temp_Pos * 4 ) ; 

RCDT.AFLT(Temp_Addr , Temp_Flt) ; 

end  loop; 
end  Load_Flts ; 

pragma  page; 

- save  all  the  integers  from  RODS  Integer  Component  to  a disk  file 
procedure  Save_Ints (Out file  : in  FILE_TYPE) 

Temp_Addr  : system. address; 

b6Dut( Out file,  "Number  Of  Integers  is:  "); 

Int  10. put (Out file,  RCDT.INT_SIZE) ; 
new- line (Outf ile) ; 
for- 1 in  1. .RCDT.INT_SIZE  loop 
put (Outf ile,  "Integer  number  ”) ; 

Int_IO. put (Out file,  1-1,  width  ->  5); 

Temp°Addr ^ Shmiddr  + system. off set ( (I-l) *4) ; 

Int_IO . put ( Out f i le , RCDT . FINT ( Temp_Addr ) ) ; 
new_line( Outf ile) ; 

end  loop; 
end  Save_Ints; 

- save  all  the  characters  from  RODB  Character  Component  to  a disk  file 
procedure  Save_Chars (Outf lie  : in  FILE_TY  ) 

Temp_Addr  : system.address; 

b6put( Outf ile,  "Number  Of  Characters  is:  ") ; 

Int  10. put (Outf ile,  RCDT.CHAR_SIZE) ; 

new- line (Outf ile) ; 

for- I in  1. .RCDT.CHAR_SIZE  loop 

put (Outf ile,  "Character  number  ") ; 

Int_IO.put (Outf ile,  I-l,  width  ->  5) ; 

?emp°Addr1?i  staiddr  + system . of f set ( RCDT . CHAR_OFFSET  + I-l); 
put ( Out f i le , RCDT . FCHAR ( Temp_Addr ) ) ; 
new_line( Outf ile) ; 
end  loop; 
end  Save_Chars; 

- save  all  the  boolean*  from  RODB  Boolean  ^”|°n?nt  to  a disk  file 
procedure  Save_Bools (Outf lie  : in  FILEJTYPE) 

Temp_Addr  : system.address; 

b6put (Outf ile,  "Number  Of  Booleans  is:  ") ; 

Int  10. put (Outf ile,  RCDT.BOOL_SIZE) ; 
new- line (Outf ile) ; 
for- I in  1. .RCDT.BOOL_SIZE  loop 
put (Outf ile,  "Boolean  number  ") ; 

Int_IO.put (Outf ile,  I-l,  width  ->  5); 

Temp°Addr^t=  Shmiidr  + system. offset (RCDT.BOOL_OFFSET  + I-l); 

Bool  10. put (Outf ile,  RCDT.FBOOL(Temp_Addr) ) , 
new_Tine( Out file) ; 


end  loop ; 
end  Save_Boo Is; 


Save  all  the  floats  from  RODB  Float  Component  to  a disk 
procedure  Save_Flts  (Outf lie  : in  FILE  ^Y^is 
Temp_Addr  i system. address; 
begin 

put (Outf ile,  "Number  Of  Floats  is  ") • 

Int_IO. put ( Outf ile,  RCDT.FLT  SIZE);  ' 
new_line (Outf ile) ; “ 

for  I in  1 . . RCDT . FLT_SIZE  loop 
put (Outf ile,  "Float  number  "); 

Int_IO. put (Outf ile,  1-1) ; 
put (Outf ile,  ":"); 

f5?*ddr  + system,  offset  (RCDT.FLT  OFFSET  + (I-l)*4) 
Flt_IO. put (Out file,  RCDT. FFLT (Temp  Addr) ) ; ~ 1 4' 

new_line(  Out  file) ; - ''' 

end  loop; 
end  Save  Fits; 


pragma  page; 
begin 

i^Staid  -C^‘SS°ET(RCDT'SHMKEY'  RCDT-SHM_SIZE,  1023); 

raise  Shm  Exception; 
end  if; 

f^^H^DT'SHMJT(Sh"id'  astern. null  address,  o)  ; 
if  Shmaddr  - system. null_address  then- 
raise  Shm_Exception; 

— end  if; 

Semid  :*  RCDT. SEMGET (RCDT. SEMKEY.  3 1023^ • 

if  Semid  = -l  then 
raise  Sem  Exception; 
end  if; 

end  Rodb_Component ; 
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/include 

/include 

/include 


<sys/types.h> 

<sys/ipc.h> 

<sys/sem.h> 


/*  The  operations  on  semaphores  */ 
struct  sembuf  RREAD_START  = { 0 1 ob- 
struct sembuf  RWAIT_NO_WRITE  LOCK  - / i'  o'  Ob- 
struct sembuf  RWAIT_NO_WRITE_DESIRE  = { 2 o'  0}- 


int  readbeg ( semid) 
int  semid; 

{ 

struct  sembuf  one  of  n readers [31; 
int  flag;  ~ 

void  perror() ; 


/*  Three  semaphore  operations  */ 


/*  Perform  three  semaphore  operations  */ 
one_of__n_readers [ 0 ] - RWAIT_NO_WRITE  LOCK; 
one_of _n_r  eader  s [ 1 ] = RWAIT_NO_WRlTE~DES IRE ; 
one_of _n_readers [ 2 ] = RREAD_ START ; “ 

flag  = semop( semid,  one  of  n readers,  3) : 
if  (flag  ==-i){  - 

per r or ( "readbeg  fails:  ") ; 

return  flag; 

> 


/*  Wait  for  no  more  writer  */ 
/*  Wait  for  no  more  writer  */ 
/*  Prevent  writer  in  */ 

/*  Lock  the  critical  section  * 
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^include 

^include 

^include 


< sys/ types. h> 

<sys/ipc.h> 

<sys/sem.h> 


/*  The  operations  on  the  semaphore  */ 
struct  sembuf  RREAD_END  = { o,  -1,  0}; 

int  readend(semid) 
int  semid; 

{ 

int  flag; 
void  perror() ! 

/*  Perform  the  semaphore  operation  */ 

ifa(f“ag*“P-ir<d'  SREEAD-END'  1)1  /*  °m°<*  critical  section 

perror ( "readend  fails:  ")  ; 

} 

return  flag; 

} 
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/include 

/include 

/include 


<sys/types.h> 

<sys/ipc.h> 

<sys/sem.h> 


/*  The  operations  on  semaphores  ■ 
struct  sembuf  WWAIT_NO_READERS 
struct  sembuf  WREAD_START 
struct  sembuf  WWRITE_LOCK 
struct  sembuf  WWRITE_DESIRE 
struct  sembuf  WIN_PROGRESS  WRITE 


= { 

0, 

o, 

0}; 

- { 

0, 

1, 

o>; 

= { 

1 r 

1, 

0}; 

= { 

2, 

1, 

o>; 

= { 

2, 

-1, 

0}; 

int  writebeg(semid) 
int  semid; 

{ 

intUCt  sole_"riter [4 ] ; /*  Four  semaphore  operations  */ 

void  perror(); 


/*  Make  write  request  by  doing  a semaphore 
flag  = semop( semid,  &WWRITE  DESIRE,  l) • 
if  (flag  ~ -1)  { - " 

perror ( "Write-Request  in  writebeg  fails: 
return  flag; 

) 


operation  */ 


Vfl 


) ; 


/*  Perform  four  semaphore  operations  */ 
s°le_wr iter [ 0 ] - WWAIT_NO  READERS ; 
sole_writer [ 1 ] « WWRITEJLOCK; 
sole_wr iter [ 2 ] = WREAD_START; 
sole_writer[3]  = WIN_PROGRESS_WRITE ; 
flag  = semop( semid,  sole  writer,  4);  / 

if  (flag  ==  -i)  { ' 

^ perror ("Writestart  in  writebeg  fails: 

pause () ; 
return  flag; 


/*  Wait  for  no  more  readers  */ 

/*  preventing  succeeding  readers 
/*  preventing  succeeding  writers 
/*  Cancel  the  write-request  */ 

* Lock  the  critical  section  */ 


> 
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0.  O'  O'  O' 


/include 

/include 

/include 


<sys/types.h> 

<sys/ipc.h> 

<sys/sem.h> 


/*  The  operations  on  semaphores  */ 
struct  sembuf  WREAD_END  = { 0,  -1  ob- 

struct sembuf  WWRITE_UNLOCK  = { 1)  -i'  o> ; 

int  writeend ( semid) 
int  semid; 

{ 

struct  sembuf  sole_writer[2] ; /*  Two  semaphore  operations  */ 

void  perror ( ) ; 


/*  Perform  the  semaphore  operation  */ 
sole_writer [ 0 ] * WREAD_END ; 
solewriter [ l ] = WWRITE_UNL0CK; 
flag  - semop (semid,  sole  writer,  2) ; 
if  (flag  = -i)  { 

perror ("writeend  fails:  ; 

} 

return  flag; 


/*  Allow  writer  in  */ 

/*  Allow  reader  in  */ 

/*  Unlock  critical  section  */ 
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/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semsinit (semid) 
int  semid; 

{ 

short  initarray[3] ; 
int  flag; 
void  perror ( ) ; 

initarray [0]  = initarrayfi]  * initarray[21 
“ semctl (semid,  3,  SETALL,  initarray) 
if  (flag  ==  -1)  { 

perror ("sems in it  fails:  ")  ; 

> 

return (flag) ; 

> 
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/include  <sys/ types. h> 

/include  <sys/ipc.h> 

/include  <sys/sem.h> 
int  semsrmv  ( semid) 
int  semid; 

{ 

int  flag; 
void  perror ( ) ; 

flag  * semctl (semid,  3,  IPC  RMID,  0) 
if  (flag  ==  -l)  { ~ 

perror ("semsrmv  fails:  " 

} 

return (flag) ; 
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